|
本帖最后由 hasyh2008 于 2022-5-13 07:47 编辑
好变态的表格!!
Sub 筛选报表()
Dim Arr1, Arr2, Brr, Str$
Dim Rc%, Cl%, X%, ZY%, BY%, K%
Arr1 = Sheet1.Range("A1").CurrentRegion
Arr2 = Application.Transpose(Sheet1.Range("A1:AJ1"))
Sheet2.Range("A2:AJ10000") = ""
Brr = Sheet2.Range("B1:AJ1")
Str = Sheet3.Range("A3") & Sheet3.Range("B3")
K = 2
For Rc = 2 To UBound(Arr1)
If Arr1(Rc, 4) & Arr1(Rc, 2) = Str Then
For Cl = 1 To UBound(Arr1, 2)
ReDim Preserve Arr2(1 To 36, 1 To K)
Arr2(Cl, K) = Arr1(Rc, Cl)
Next Cl
K = K + 1
End If
Next Rc
If K = 2 Then Exit Sub
Arr2 = Application.Transpose(Arr2)
For BY = 1 To 35
For ZY = 1 To 35
If Brr(1, BY) = Arr2(1, ZY) Then
For X = 1 To K - 1
Arr2(X, 36) = Arr2(X, BY)
Arr2(X, BY) = Arr2(X, ZY)
Arr2(X, ZY) = Arr2(X, 36)
Arr2(X, 36) = ""
Next X
End If
Next ZY
Next BY
Sheet2.Range("B1").Resize(K - 1, 35) = Arr2
For X = 2 To K - 1
Sheet2.Cells(X, 1) = X - 1
Next X
End Sub
|
评分
-
查看全部评分
|