用于对帐的VBA行
我是新的VBA用户，试图组装一个非常基本的贸易对帐模板。我似乎已经完成了大部分工作，但我似乎无法解决排序行为“这样”所有在不同行行上显示不匹配的股票。正如您所看到的，我能够对匹配的项目的主要部分进行排序，但所有不匹配的项目都被推到了底部。这很好，但实际上它们应该在不同的行上以直观地显示每个行项目是单独无法匹配的。
就我的代码而言，这是我能得到的。用所有不匹配的项目分隔行，其中说库存名称（A4与H4）以及数量（E4与L4）不匹配全部应该被移动到他们自己的行项目 - 以视觉确认最终读者那里是无与伦比的。
Sub Sample_Trade_Recon()
Application.ScreenUpdating = False
' Tab 1 & Tab 2 Raw data pasted in. Do a prelim sort of the actual columns
you want compare on the summary sheet'
Sheets("QT").Select Range("A3:G300").Select
ActiveWorkbook.Worksheets("QT").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("QT").Sort.SortFields.Add Key:=Range("A3:A300"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("QT").Sort.SortFields.Add Key:=Range("B3:B300"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("QT").Sort.SortFields.Add Key:=Range("C3:C300"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("QT").Sort.SortFields.Add Key:=Range("D3:D300"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("QT").Sort.SortFields.Add Key:=Range("E3:E300"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("QT").Sort.SortFields.Add Key:=Range("F3:F300"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("QT").Sort.SortFields.Add Key:=Range("G3:G300"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal With
ActiveWorkbook.Worksheets("QT").Sort .SetRange Range("A3:G300") .Header =
xlGuess .MatchCase = False .Orientation = xlTopToBottom .SortMethod =
xlPinYin .Apply End With
Sheets("SSC").Select
Range("A3:G300").Select
ActiveWorkbook.Worksheets("SSC").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("SSC").Sort.SortFields.Add Key:=Range("A3:A300"),
_
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("SSC").Sort.SortFields.Add Key:=Range("B3:B300"),
_
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("SSC").Sort.SortFields.Add Key:=Range("C3:C300"),
_
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("SSC").Sort.SortFields.Add Key:=Range("D3:D300"),
_
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("SSC").Sort.SortFields.Add Key:=Range("E3:E300"),
_
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("SSC").Sort.SortFields.Add Key:=Range("F3:F300"),
_
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("SSC").Sort.SortFields.Add Key:=Range("G3:G300"),
_
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("SSC").Sort
.SetRange Range("A3:G300")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
' Tab 1 Raw data columns you want compared '
Sheets("QT").Select
Range("A3:A40").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Recon").Select
Range("A4").Select
Selection.PasteSpecial Paste:=xlPasteValues
Sheets("QT").Select
Range("B3:B40").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Recon").Select
Range("B4").Select
Selection.PasteSpecial Paste:=xlPasteValues
Sheets("QT").Select
Range("C3:C40").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Recon").Select
Range("C4").Select
Selection.PasteSpecial Paste:=xlPasteValues
Selection.NumberFormat = "m/d/yyyy"
Sheets("QT").Select
Range("D3:D40").Select
Selection.Copy
Sheets("Recon").Select
Range("D4").Select
Selection.PasteSpecial Paste:=xlPasteValues
Selection.NumberFormat = "m/d/yyyy"
Sheets("QT").Select
Range("E3:E40").Select
Selection.Copy
Sheets("Recon").Select
Range("E4").Select
Selection.PasteSpecial Paste:=xlPasteValues
Sheets("QT").Select
Range("F3:F40").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Recon").Select
Range("F4").Select
Selection.PasteSpecial Paste:=xlPasteValues
Sheets("QT").Select
Range("G3:G40").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Recon").Select
Range("G4").Select
Selection.PasteSpecial Paste:=xlPasteValues
' Tab 2 Raw data columns you want compared '
Sheets("SSC").Select
Range("A3:A45").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Recon").Select
Range("H4").Select
Selection.PasteSpecial Paste:=xlPasteValues
Sheets("SSC").Select
Range("B3:B45").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Recon").Select
Range("I4").Select
Selection.PasteSpecial Paste:=xlPasteValues
Sheets("SSC").Select
Range("C3:C45").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Recon").Select
Range("J4").Select
Selection.PasteSpecial Paste:=xlPasteValues
Selection.NumberFormat = "m/d/yyyy"
Sheets("SSC").Select
Range("D3:D45").Select
Selection.Copy
Sheets("Recon").Select
Range("K4").Select
Selection.PasteSpecial Paste:=xlPasteValues
Selection.NumberFormat = "m/d/yyyy"
Sheets("SSC").Select
Range("E3:E45").Select
Selection.Copy
Sheets("Recon").Select
Range("L4").Select
Selection.PasteSpecial Paste:=xlPasteValues
Sheets("SSC").Select
Range("F3:F45").Select
Selection.Copy
Sheets("Recon").Select
Range("M4").Select
Selection.PasteSpecial Paste:=xlPasteValues
Sheets("SSC").Select
Range("G3:G45").Select
Selection.Copy
Sheets("Recon").Select
Range("N4").Select
Selection.PasteSpecial Paste:=xlPasteValues
MsgBox ("Recon is assembled; please comment on all differences !")
End Sub
1 个答案:
答案 0 :(得分：0)
所以看起来我非常接近所期望的行为。唯一的问题是它只发生过一次吗？
请查看更新后的代码，并告诉我是否有人可以协助解决跳过行显示时不重复的原因。
Sub Sample_Trade_Recon()
Application.ScreenUpdating = False
' Tab 1 & Tab 2 Raw data pasted in. Do a prelim sort of the actual columns
you want compare on the summary sheet'
Sheets("QT").Select
Range("A3:G300").Select
ActiveWorkbook.Worksheets("QT").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("QT").Sort.SortFields.Add Key:=Range("A3:A300"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("QT").Sort.SortFields.Add Key:=Range("B3:B300"), _
SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("QT").Sort.SortFields.Add Key:=Range("C3:C300"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("QT").Sort.SortFields.Add Key:=Range("D3:D300"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("QT").Sort.SortFields.Add Key:=Range("E3:E300"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("QT").Sort.SortFields.Add Key:=Range("F3:F300"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("QT").Sort.SortFields.Add Key:=Range("G3:G300"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("QT").Sort
.SetRange Range("A3:G300")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Sheets("SSC").Select
Range("A3:G300").Select
ActiveWorkbook.Worksheets("SSC").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("SSC").Sort.SortFields.Add Key:=Range("A3:A300"),
_
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("SSC").Sort.SortFields.Add Key:=Range("B3:B300"),
_
SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("SSC").Sort.SortFields.Add Key:=Range("C3:C300"),
_
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("SSC").Sort.SortFields.Add Key:=Range("D3:D300"),
_
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("SSC").Sort.SortFields.Add Key:=Range("E3:E300"),
_
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("SSC").Sort.SortFields.Add Key:=Range("F3:F300"),
_
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("SSC").Sort.SortFields.Add Key:=Range("G3:G300"),
_
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("SSC").Sort
.SetRange Range("A3:G300")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
' Tab 1 Raw data columns you want compared '
Sheets("QT").Select
Range("A3:A300").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Recon").Select
Range("A4").Select
Selection.PasteSpecial Paste:=xlPasteValues
Sheets("QT").Select
Range("B3:B300").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Recon").Select
Range("B4").Select
Selection.PasteSpecial Paste:=xlPasteValues
Sheets("QT").Select
Range("C3:C300").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Recon").Select
Range("C4").Select
Selection.PasteSpecial Paste:=xlPasteValues
Selection.NumberFormat = "m/d/yyyy"
Sheets("QT").Select
Range("D3:D300").Select
Selection.Copy
Sheets("Recon").Select
Range("D4").Select
Selection.PasteSpecial Paste:=xlPasteValues
Selection.NumberFormat = "m/d/yyyy"
Sheets("QT").Select
Range("E3:E300").Select
Selection.Copy
Sheets("Recon").Select
Range("E4").Select
Selection.PasteSpecial Paste:=xlPasteValues
Sheets("QT").Select
Range("F3:F300").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Recon").Select
Range("F4").Select
Selection.PasteSpecial Paste:=xlPasteValues
Sheets("QT").Select
Range("G3:G300").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Recon").Select
Range("G4").Select
Selection.PasteSpecial Paste:=xlPasteValues
' Tab 2 Raw data columns you want compared '
Sheets("SSC").Select
Range("A3:A300").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Recon").Select
Range("H4").Select
Selection.PasteSpecial Paste:=xlPasteValues
Sheets("SSC").Select
Range("B3:B300").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Recon").Select
Range("I4").Select
Selection.PasteSpecial Paste:=xlPasteValues
Sheets("SSC").Select
Range("C3:C300").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Recon").Select
Range("J4").Select
Selection.PasteSpecial Paste:=xlPasteValues
Selection.NumberFormat = "m/d/yyyy"
Sheets("SSC").Select
Range("D3:D300").Select
Selection.Copy
Sheets("Recon").Select
Range("K4").Select
Selection.PasteSpecial Paste:=xlPasteValues
Selection.NumberFormat = "m/d/yyyy"
Sheets("SSC").Select
Range("E3:E300").Select
Selection.Copy
Sheets("Recon").Select
Range("L4").Select
Selection.PasteSpecial Paste:=xlPasteValues
Sheets("SSC").Select
Range("F3:F300").Select
Selection.Copy
Sheets("Recon").Select
Range("M4").Select
Selection.PasteSpecial Paste:=xlPasteValues
Sheets("SSC").Select
Range("G3:G300").Select
Selection.Copy
Sheets("Recon").Select
Range("N4").Select
Selection.PasteSpecial Paste:=xlPasteValues
'Dynamic Sorting based on column total lengths'
Dim lastA, lastB, shortCol, rw As Integer
'Determine short column so we know when to stop
lastA = WorksheetFunction.CountA(Range("A:A"))
lastB = WorksheetFunction.CountA(Range("H:H"))
If lastA > lastB Then _
shortCol = 2 Else shortCol = 1
'Set First Check Row
rw = 4
nxtChk:
'Check Column A against Column H, Row by Row
'Insert cell at non-matching data
If Cells(rw, 26) <> "Keep" And shortCol = 2 Then
Cells(rw, 8).Insert shift:=xlDown
Cells(rw, 9).Insert shift:=xlDown
Cells(rw, 10).Insert shift:=xlDown
Cells(rw, 11).Insert shift:=xlDown
Cells(rw, 12).Insert shift:=xlDown
Cells(rw, 13).Insert shift:=xlDown
Cells(rw, 14).Insert shift:=xlDown
Refresh all formulas in difference column so excel knows where to insert
the skip row (based on formulas)'
Range("O4:Z4").Select
Selection.AutoFill Destination:=Range("O4:Z300")
Else
If Cells(rw, 26) <> "Keep" And shortCol = 1 Then
Cells(rw, 1).Insert shift:=xlDown
Cells(rw, 2).Insert shift:=xlDown
Cells(rw, 3).Insert shift:=xlDown
Cells(rw, 4).Insert shift:=xlDown
Cells(rw, 5).Insert shift:=xlDown
Cells(rw, 6).Insert shift:=xlDown
Cells(rw, 7).Insert shift:=xlDown
'Refresh all formulas in difference column so excel knows where to insert
the skip row (based on formulas)'
Range("O4:Z4").Select
Selection.AutoFill Destination:=Range("O4:Z300")
End If
'If there is nothing left to check in the skiprow column , we're done
If Cells(rw, 26) = " " Then Exit Sub
'If not, increment Row counter and loop
rw = rw + 1
GoTo nxtChk
End If
Range("O4:Z4").Select
Selection.AutoFill Destination:=Range("O4:Z300")
Application.ScreenUpdating = True
'Operations Team notices to review data presentation'
MsgBox ("Please insert comments into Column AA for all differences !")
MsgBox ("NOTE: If identifer data sorting is off slightly; then please fix by
repasting the data grids on either side up/down a row as needed to realign
properly. This often happens when Identifiers Repeat ")
End Sub
相关问题
最新问题
- 我写了这段代码，但我无法理解我的错误
- 我无法从一个代码实例的列表中删除 None 值，但我可以在另一个实例中。为什么它适用于一个细分市场而不适用于另一个细分市场？
- 是否有可能使 loadstring 不可能等于打印？卢阿
- java中的random.expovariate()
- Appscript 通过会议在 Google 日历中发送电子邮件和创建活动
- 为什么我的 Onclick 箭头功能在 React 中不起作用？
- 在此代码中是否有使用“this”的替代方法？
- 在 SQL Server 和 PostgreSQL 上查询，我如何从第一个表获得第二个表的可视化
- 每千个数字得到
- 更新了城市边界 KML 文件的来源？