Snasui Excel Forum

Code: Select all

Dim allHd As Range, hd As Range
Dim itms As Range, rs As Range, it As Range
Dim w1 As Worksheet, w2 As Worksheet, col As Long

Set w1 = Workbooks("Book1 (2).xlsm").Worksheets("Sheet1")
Set w2 = Workbooks("Book2 (2).xlsm").Worksheets("Sheet2")

Set rs = w1.Range("a2").Resize(10000).SpecialCells(xlCellTypeConstants)
With w2
    Set allHd = .Range("a1", .Range("a1").End(xlToRight))
    For Each hd In allHd
        If hd.Value = "รายการ" Then
            Set itms = hd.Offset(1, 0).Resize(10000).SpecialCells(xlCellTypeConstants)
            col = 0
        Else
            col = col + 1
            For Each it In itms
                If Application.CountIf(rs, it) > 0 Then
                    it.Offset(0, col).Value = Application.Index(rs.Offset(0, 1), _
                        Application.Match(it, rs, 0))
                End If
            Next
        End If
    Next hd
End With

Code: Select all

Sub UpdateW1()

Dim w1 As Worksheet, w2 As Worksheet
Dim a, c As Range, FR As Long

Application.ScreenUpdating = False
    Set w1 = Workbooks("Book1.xlsm").Worksheets("Sheet1")
    Set w2 = Workbooks("Book2.xlsm").Worksheets("Sheet2")

        For Each a In w2.Range("A2", w2.Range("A" & Rows.Count).End(xlUp))
            FR = 0
  On Error Resume Next
            FR = Application.Match(a, w1.Columns(1), 0)
  On Error GoTo 0
            If FR <> 0 Then a.Offset(, 1).Value = w1.Cells(FR, 2).Value
  
        For Each c In w2.Range("D2", w2.Range("D" & Rows.Count).End(xlUp))
            FR = 0
  On Error Resume Next
            FR = Application.Match(c, w1.Columns(1), 0)
  On Error GoTo 0
            If FR <> 0 Then c.Offset(, 1).Value = w1.Cells(FR, 2).Value
        Next c
    Next a

Application.ScreenUpdating = True

End Sub