- 帖子
- 408
- 主題
- 59
- 精華
- 0
- 積分
- 493
- 點名
- 29
- 作業系統
- win7
- 軟體版本
- office 2010
- 閱讀權限
- 20
- 性別
- 男
- 註冊時間
- 2012-10-30
- 最後登錄
- 2024-6-3
|
14#
發表於 2024-1-2 10:09
| 只看該作者
回復 12# 准提部林
因爲繁簡體問題，導致亂碼，導致無法運行。 因爲沒有原文，我無法修正亂碼部分。可否發一下原文給我修正。
Sub ╊だ()
Attribute ╊だ.VB_Description = "矗场狶 2024/1/1 魁籹エ栋"
Attribute ╊だ.VB_ProcData.VB_Invoke_Func = " \n14"
Dim Arr, Brr, Drr, Xrr, Yrr, xD, xS As Worksheet, vS As Worksheet, R&, S$, T$, i&, j&, k%, x&, y%, N&
Call 埃
Set xD = CreateObject("Scripting.Dictionary")
Set vS = Sheets("逼琜"): Xrr = vS.[a8:f8]
Arr = Range(vS.[b1], vS.[d65536].End(xlUp))
For i = 9 To UBound(Arr)
T = Arr(i, 2)
If T Like "SR####" Then xD(T) = vS.Cells(i, 2).MergeArea.Resize(, 5).Value
Next i
'-----------------------------
Set xS = Sheets("BF")
Arr = Range(xS.[f1], xS.[a65536].End(xlUp).MergeArea)
For i = 2 To UBound(Arr)
If Arr(i, 1) Like "BF祘[#]###*" Then
S = Mid(Arr(i, 1), 5, 4): N = 0
Brr = xS.Cells(i, 1).MergeArea.Resize(, 5).Value
ReDim Yrr(1 To 2000, 1 To 6)
N = N + 1
For y = 1 To 6: Yrr(N, y) = Xrr(1, Mid(123645, y, 1)): Next
For j = 1 To UBound(Brr)
For k = 2 To UBound(Brr, 2)
If Brr(j, k) Like "*琜*SR####*" Then
T = Mid(Brr(j, k), 4, 6)
Drr = xD(T)
If IsArray(Drr) Then
For x = 1 To UBound(Drr)
N = N + 1
Yrr(N, 1) = "=row()-1"
Yrr(N, 2) = Drr(1, 1)
Yrr(N, 3) = Drr(1, 2)
Yrr(N, 4) = Drr(1, 5)
Yrr(N, 5) = Drr(1, 3)
Yrr(N, 6) = Drr(1, 4)
Next x
End If
End If
Next k
Next j
'-----------------------------------
If N <= 1 Then GoTo i01
Set vS = Sheets.Add(after:=vS): vS.Name = S
With vS.[a1].Resize(N, 6)
.Value = Yrr
.Borders.LineStyle = 1
.Sort Key1:=.Item(3), Order1:=xlAscending, _
Key2:=.Item(4), Order2:=xlAscending, _
Key3:=.Item(2), Order3:=xlAscending, Header:=xlYes
T = "'" & S & "'!" & .Address
End With
'-----------------------------------
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:=T).CreatePivotTable TableDestination:=vS.Range("i1"), TableName:="Pvt_1"
vS.PivotTables("Pvt_1").AddFields RowFields:=vS.Range("C1"), ColumnFields:=vS.Range("d1")
vS.PivotTables("Pvt_1").PivotFields(vS.Range("F1").Text).Orientation = xlDataField
End If
Application.CommandBars("PivotTable").Visible = False
i01: Next i
End Sub
Sub 埃()
Dim xS As Worksheet
Application.DisplayAlerts = False
For Each xS In Sheets
If xS.Name Like "[#]###" Then xS.Delete
Next
End Sub
Sub ttt()
MsgBox Val("11 22")
End Sub
Sub Macro2()
'
' Macro2 エ栋
' 矗场狶 2024/1/1 魁籹エ栋
'
'
' Columns("B:F").Select
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:="'#001'!C1:f86").CreatePivotTable TableDestination:=Range("i1"), TableName:="枷だ猂1"
'ActiveSheet.PivotTables("枷だ猂1").SmallGrid = False
ActiveSheet.PivotTables("枷だ猂1").AddFields RowFields:=Range("C1"), ColumnFields:=Range("d1")
ActiveSheet.PivotTables("枷だ猂1").PivotFields(Range("F1").Text).Orientation = xlDataField
End Sub |
|
發表於 2024-1-2 14:16
| 
