ค้นหาข้อมูลหลายชืตด้วย VBA โดยมีข้อมูลเป็น Hyperlink

[bounlam]

ลบกวนผู้รู้ครับ
ผมทำตามแล้วครับยอดเยี่อมมากเลยแต่ผมพบปัญหานิดหน่อยครับ
ผมมีข้อมูลใน sheet2 เป็น Hyperlink เมื่อนำข้อมูลมาลายงานใน sheet 1 พบว่าไม้สามาดกดข้อมูลที่เป็น hyperlink ได้ครับ จะแก้ไขอย่างไรครับ

[snasui]

ตัวอย่างการปรับ Code ครับ

Code: Select all

Sub searchMultiplesheets()
    Dim r As Range, t As Range
    Dim ws As Worksheet, i As Integer, s As String
    With Sheets(1)
        s = .Range("c1").Value
        .Range("a3").Resize(.UsedRange.Rows.Count, .UsedRange.Columns.Count).ClearContents
    End With
    For Each ws In Worksheets
    If ws.Name <> Sheets(1).Name Then
        With ws
            For Each r In .Range("a2", .Range("a" & .Rows.Count).End(xlUp))
                If r.Value & r.Offset(0, 1).Value & _
                    r.Offset(0, 2).Value & r.Offset(0, 3).Value Like "*" & s & "*" Then
                    With Sheets(1)
                        Set t = .Range("a" & .Rows.Count).End(xlUp).Offset(1, 0) _
                            .Resize(1, 4)
                        r.Resize(1, 4).Copy t
                    End With
                    Application.CutCopyMode = False
                End If
            Next r
        End With
    End If
    Next ws
End Sub

[bounlam]

ใส่ code ไปแล้วครับ
ผมส้างปุ่ม save ขื้นมาแล้วแต่ save เป็น hyperlink ไม้ได้ครับ
ปุ่ม search ไม้ทำงาน
รบกวนดู ให้หน่อยนะครับ

[snasui]

ตัวอย่างการปรับ Code ครับ

Code: Select all

'Other code
With ws
    For Each r In .Range("a2", .Range("a" & .Rows.Count).End(xlUp))
        If r.Value & r.Offset(0, 1).Value & r.Offset(0, 2).Value & r.Offset(0, 3).Value & _
        r.Offset(0, 4).Value & r.Offset(0, 5).Value & r.Offset(0, 5).Value & _
        r.Offset(0, 6).Value & r.Offset(0, 7).Value & r.Offset(0, 8).Value & _
        r.Offset(0, 9).Value Like "*" & s & "*" Then
            With Sheets(1)
                Set t = .Range("a" & .Rows.Count).End(xlUp).Offset(1, 0).Resize(1, 10)
                r.Resize(1, 10).Copy t
            End With
            Application.CutCopyMode = False
        End If
    Next r
End With

'Other code

[bounlam]

ขอบคุญมากๆครับ..............
รบกวนอืกนิดครับดู code ปุ่ม save ให้หน่อยใน sheet 1 จะเขียนยังไงให้ cell c8 บัญทึกเป็น hyperlink ครับ

[puriwutpokin]

ลองปรับเป็น

Code: Select all

Private Sub sv_Click()

If Range("f4") = "Import" Then
    i = WorksheetFunction.CountA(Worksheets("data").Columns("D:D")) + 1
    Worksheets("data").Cells(i, 2).Value = Range("c4").Value
    Worksheets("data").Cells(i, 3).Value = Range("c5").Value
    Worksheets("data").Cells(i, 4).Value = Range("c6").Value
    Worksheets("data").Cells(i, 5).Value = Range("c7").Value
    Worksheets("data").Cells(i, 6).Value = Range("d7").Value
    Worksheets("data").Cells(i, 7).Value = Range("f7").Value
    Worksheets("data").Cells(i, 8).Value = Range("f5").Value
    Worksheets("data").Cells(i, 9).Value = Range("f4").Value
    Worksheets("data").Cells(i, 10).Value = Range("c8").Value
 Else

    If Range("f4") = "Export" Then
    If Not Worksheets("data2").Columns("G:G").Find(Range("c7"), LookIn:=xlValues) Is Nothing Then
    
    MsgBox "same number can't save"
   
    Else
    i = WorksheetFunction.CountA(Worksheets("data2").Columns("D:D")) + 1
    Worksheets("data2").Cells(i, 2).Value = Range("c4").Value
    Worksheets("data2").Cells(i, 3).Value = Range("c5").Value
    Worksheets("data2").Cells(i, 4).Value = Range("c6").Value
    Worksheets("data2").Cells(i, 5).Value = Range("c7").Value
    Worksheets("data2").Cells(i, 6).Value = Range("d7").Value
    Worksheets("data2").Cells(i, 7).Value = Range("f7").Value
    Worksheets("data2").Cells(i, 8).Value = Range("f5").Value
    Worksheets("data2").Cells(i, 9).Value = Range("f4").Value
    Worksheets("data2").Cells(i, 10).Value = Range("c8").Value
    End If
    End If
End If
        ThisWorkbook.Sheets("Index").Hyperlinks.Add Anchor:=Range("C8"), Address:= _
        Range("C8").Value, TextToDisplay:=Range("C8").Value
End Sub

[bounlam]

save ไปที่ sheet data ได้ครับแต่ข้อมูล c8 จาก sheet index ทีบัญทึกไปยังไม่เป็น Hyperlink เลยครับ

[puriwutpokin]

ตัวอย่างโค้ดครับ

Code: Select all

Private Sub sv_Click()
If Range("f4") = "Import" Then
    i = WorksheetFunction.CountA(Worksheets("data").Columns("D:D")) + 1
    Worksheets("data").Cells(i, 2).Value = Range("c4").Value
    Worksheets("data").Cells(i, 3).Value = Range("c5").Value
    Worksheets("data").Cells(i, 4).Value = Range("c6").Value
    Worksheets("data").Cells(i, 5).Value = Range("c7").Value
    Worksheets("data").Cells(i, 6).Value = Range("d7").Value
    Worksheets("data").Cells(i, 7).Value = Range("f7").Value
    Worksheets("data").Cells(i, 8).Value = Range("f5").Value
    Worksheets("data").Cells(i, 9).Value = Range("f4").Value
    Worksheets("data").Hyperlinks.Add Worksheets("data").Cells(i, 10), Address:= _
        Range("c8").Value, TextToDisplay:=Range("c8").Value
 Else
    If Range("f4") = "Export" Then
    If Not Worksheets("data2").Columns("G:G").Find(Range("c7"), LookIn:=xlValues) Is Nothing Then
    MsgBox "same number can't save"
    Else
    i = WorksheetFunction.CountA(Worksheets("data2").Columns("D:D")) + 1
    Worksheets("data2").Cells(i, 2).Value = Range("c4").Value
    Worksheets("data2").Cells(i, 3).Value = Range("c5").Value
    Worksheets("data2").Cells(i, 4).Value = Range("c6").Value
    Worksheets("data2").Cells(i, 5).Value = Range("c7").Value
    Worksheets("data2").Cells(i, 6).Value = Range("d7").Value
    Worksheets("data2").Cells(i, 7).Value = Range("f7").Value
    Worksheets("data2").Cells(i, 8).Value = Range("f5").Value
    Worksheets("data2").Cells(i, 9).Value = Range("f4").Value
    Worksheets("data2").Hyperlinks.Add Worksheets("data2").Cells(i, 10), Address:= _
        Range("c8").Value, TextToDisplay:=Range("c8").Value
    End If
    End If
End If
End Sub

[bounlam]

สวัสดีครับดูให้หน่อย code ล่าสุดทีให้สามารถ save เป็น hyperlink ได้ครับ แต่ไม้สามารถเปิดไฟล์ได้ครับ

[puriwutpokin]

สวัสดีครับดูให้หน่อย code ล่าสุดทีให้สามารถ save เป็น hyperlink ได้ครับ แต่ไม้สามารถเปิดไฟล์ได้ครับ

ไม่ได้ระบุเส้นทางเดินของPath และไฟล์ที่จะเปิด Hyperlink ก็หาไม่เจอครับ
ต้องกำหนด ด้วยครับ Path และไฟล์ที่จะเปิดครับ

[bounlam]

ขอบคุญมากๆครับ
ปุ่ม search เวลากดแล้วข้อมูลที่มาโชว์เลขลำดับเป็น #VALUE! แก้ไงครับ

[puriwutpokin]

ขอบคุญมากๆครับ
ปุ่ม search เวลากดแล้วข้อมูลที่มาโชว์เลขลำดับเป็น #VALUE! แก้ไงครับ

ปรับที่ A13=IF(B13="","",ROWS(A$13:A13)) คัดลอกลงครับ