Option Explicit
Sub TEST()
Dim K$, i&, j%, C%, N&, Brr
Range([總表!A1], Sheets("總表").UsedRange).Offset(2, 1).Clear
Brr = Range([資料!IV3].End(xlToLeft), [資料!A65536].End(xlUp)(1, 2))
K = [總表!A2]: N = 8: C = UBound(Brr, 2)
For j = 1 To C
If K <> Brr(1, j) Then
For i = 1 To N + 1
Brr(i, j) = ""
Next
End If
Next
[總表!B3].Resize(N + 1, C) = Brr
End Sub作者: Andy2483 時間: 2024-3-28 08:45
方案2 請前輩參考:
Option Explicit
Sub TEST_2()
Dim K$, i&, j%, C%, N&, Brr, Crr
Range([總表!A1], Sheets("總表").UsedRange).Offset(2, 1).Clear
Brr = Range([資料!IV3].End(xlToLeft), [資料!A65536].End(xlUp)(1, 2))
K = [總表!A2]: N = 8: C = UBound(Brr, 2)
ReDim Crr(1 To UBound(Brr), 1 To C)
For j = 1 To C
If K = Brr(1, j) Then
For i = 1 To N + 1
Crr(i, j) = Brr(i, j)
Next
End If
Next
[總表!B3].Resize(N + 1, C) = Crr
End Sub