รบกวนแก้ไข Code ในการดึงข้อมูลข้าม Sheet ให้หน่อยครับ

[chutchas]

เรียน พี่ๆทุกท่านครับ

คือว่าผมต้องทำการจับคู่ข้อมูล "เลขที่สินค้า" กับ "เลขที่ใบจ่าย" ในแต่ละเดือน
โดยประกอบด้วยข้อมูลดังนี้ครับ
Sheet1 : PI - จะเก็บข้อมูล "เลขที่สินค้า" ที่จับคู่กับ "เลขที่ใบจ่าย" (ข้อมูลนี้ได้มีทีหลัง)
Sheet2 : Jan - จะเก็บข้อมูลงานรายเดือน ซึ่งตอนแรกจะมีแต่ข้อมูล "เลขที่สินค้า"

แต่ปัญหาคือใน Sheet2 :Jan - บาง Cell นั้นจะมี เลขที่สินค้า 2 ชุด(ชุดละ 9 ตัวอักษร)
ผมจึงต้องดึงข้อมูลทีละ9 ตัวก่อน แล้วนำ "เลขที่สินค้า" ที่ได้ไปเช็ค กับ
Sheet 1: PI ว่า "เลขที่ใบจ่าย" อะไร แล้วนำกลับมาใส่ Sheet 2

ผมเขียน Code ด้งนี้ครับ แต่ Error ครับ

Code: Select all

Public Sub Upload()
Dim Month As String
    Dim Ans, PiNo(100), CelVal As Variant
    Dim FirstRow, i, j, k, l As Integer
    
    Month = InputBox("¡ÃسҡÃÍ¡à´×͹", "Input Month (Ex. Jan , Feb, Mar)")
    Sheets(Month).Activate
    
    FirstRow = 1
    i = 1
    k = 100
    
    While k > 0
          k = k - 1       'k = 100-1 = 99
          i = i + 1        ' i = 1 + 1 = 2
          
          CelVal = Cells(FirstRow + i, 2).Value    ' CelVal = Cells(1+2,2).value
          
          If CelVal <> 0 Then     ' 410253817 <> 0
             ' Reset k while have data row
             k = 100
             j = 0
             ' Create each PiNo
             j = j + 1                      ' j = 0+1 = 1
             PiNo(j) = ""             'PiNo(1) = ""
             
             For l = 1 To Len(CelVal)             'For l = 1 To 9
                 If Asc(Mid(CelVal, l, 1)) <> 10 And Asc(Mid(CelVal, l, 1)) <> 32 Then          ' if 4<>10  And 4<>40 then
                    PiNo(j) = PiNo(j) & Mid(CelVal, l, 1)                                                                     'PiNo(1) = "" & 4
                 Else
                    j = j + 1
                 End If
             Next l
             
             Ans = ""
             
             For l = 1 To j
                  Ans = Ans & WorksheetFunction.VLookup(Val(PiNo(l)), Worksheets("PI").Range("B:C"), 2, 0)
                  If l < j Then Ans = Ans & Chr(10)
             Next l
          
             Cells(FirstRow + i, 3).Value = Ans
          
          
          End If
    Wend

End Sub

[menem]

มีแก้ไข 2 จุดนะครับ
If CelVal <> 0 Then ' 410253817 <> 0
เป็น If CelVal <> 0 And Len(CelVal) > 7 Then ' 410253817 <> 0

และ
เพิ่มคำสั่งใน
Else
j = j + 1
End If

เป็น Else
j = j + 1
PiNo(j) = ""
End If

Code: Select all

Public Sub Upload()
Dim Month As String
    Dim Ans, PiNo(100), CelVal As Variant
    Dim FirstRow, i, j, k, l As Integer
    
    Month = InputBox("¡ÃسҡÃÍ¡à´×͹", "Input Month (Ex. Jan , Feb, Mar)")
    Sheets(Month).Activate
    
    FirstRow = 1
    i = 1
    k = 100
    
    While k > 0
          k = k - 1       'k = 100-1 = 99
          i = i + 1        ' i = 1 + 1 = 2
          
          CelVal = Cells(FirstRow + i, 2).Value    ' CelVal = Cells(1+2,2).value
          
          If CelVal <> 0 And Len(CelVal) > 7 Then     ' 410253817 <> 0
             ' Reset k while have data row
             k = 100
             j = 0
             ' Create each PiNo
             j = j + 1                      ' j = 0+1 = 1
             PiNo(j) = ""             'PiNo(1) = ""
             
             For l = 1 To Len(CelVal)             'For l = 1 To 9
                 If Asc(Mid(CelVal, l, 1)) <> 10 And Asc(Mid(CelVal, l, 1)) <> 32 Then          ' if 4<>10  And 4<>40 then
                    PiNo(j) = PiNo(j) & Mid(CelVal, l, 1)                                                                     'PiNo(1) = "" & 4
                 Else
                    j = j + 1
                    PiNo(j) = ""
                 End If
             Next l
             
             Ans = ""
             
             For l = 1 To j
                  Ans = Ans & WorksheetFunction.VLookup(Val(PiNo(l)), Worksheets("PI").Range("B:C"), 2, 0)
                  If l < j Then Ans = Ans & Chr(10)
             Next l
          
             Cells(FirstRow + i, 3).Value = Ans
          
          
          End If
    Wend

End Sub

[snasui]

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

Code: Select all

Dim rngJanAll As Range, rngJan As Range
Dim janStrAll As Variant, i As Integer
Dim strJoin() As Variant, j As Integer
Dim rngPIAll As Range, rngPI As Range

With Worksheets("Jan")
    Set rngJanAll = .Range("b3", .Range("b" & .Rows.Count).End(xlUp))
End With
With Worksheets("PI")
    Set rngPIAll = .Range("b3", .Range("b" & .Rows.Count).End(xlUp))
End With
For Each rngJan In rngJanAll
    janStrAll = Split(rngJan.Value, " ")
    For i = 0 To UBound(janStrAll)
        j = 0
        For Each rngPI In rngPIAll
            If InStr(rngPI, janStrAll(i)) Then
                ReDim Preserve strJoin(j)
                strJoin(j) = rngPI.Offset(0, 1).Value
                j = j + 1
            End If
        Next rngPI
    Next i
    If IsNumeric(VBA.Left(rngJan, 1)) Then
        rngJan.Offset(0, 1).Value = Join(strJoin, vbCrLf)
    End If
Next rngJan

[chutchas]

ขอบคุณมากครับ พี่ menem และพี่ snasui