使用VBA Excel将具有相似值的表行合并 [英] Combine rows of a table with similar values using VBA Excel
问题描述
我必须做多次sumif才能解决此问题.
I have to do sumif multiple time to get this problem solved.
问题:我有一个零件编号为第一列的表,对于唯一零件它总是相同的.但是,即使对于相同的部件号(由于打字错误等),描述1和描述2也并不完美.我需要结合不同库存的数量:V1,V2和V3的数量
Problem: I have a table with Part Number as the first column and it is always the same for unique part. However, the description 1 and description 2 are not perfect, even for the same part number (due to the typo, etc). I need to combine the Quantity at different inventories: QTY AT V1, V2, and V3
如果我使用多个sumif并选择说明,则结果将首先显示.当然,大约有50k的行具有许多不同的PN#.如果使用sumif会由于人为错误而经常发生错误.
The result if I use multiple sumif and choose the the description appears first. Of course, there are like 50k of rows with many different PN#. Error often occurs if using sumif due to human error.
我想在这方面寻求帮助.比较PN#,如果它们在不同库存位置的数量相同,则描述1和2会先捡起最先出现的内容(例如CAR-BLACK和4 WHEELS).
I would like to ask for help on this one. Compare the PN# if they are the same sum the quantity at different inventory locations, the description 1 and 2 just pick up whatever appear first (like CAR - BLACK and 4 WHEELS).
对此有一些类似的问题和答案.但是,它们不能很好地工作.合并单元格
There are some similar questions and answers to this. However, they do not work well. Merge Cells
推荐答案
这应该可以解决您的问题.我用两个选项卡设置了一个工作簿:RawData和PNTotals.我创建的数据类似于您的示例中的两行.我有26行,带有3个不同的PN#:本田,丰田和起亚.不管您有多少行和PN#,该代码都能正常工作.
This should solve your problem. I set up a workbook with 2 tabs: RawData and PNTotals. I created data that resembles the two rows in your example. I have 26 rows with 3 different PN#s: Honda, Toyota, and Kia. The code works regardless of how many rows and PN#s you have.
运行以下代码后,最终在PNTotals选项卡上按PN求和,如下所示:
After running the code below, I end up with totals by PN on the PNTotals tab that look like this:
HONDA CAR - BLACK 4 WHEELS 936 516 2214
TOYOTA CAR 864 414 2079
KIA CAR - RED SPORT PACKAGE 504 204 1234
要使其正常工作,请将以下代码添加到模块中,然后运行子 DispatchTotalsByPNNumber()
.
To get this to work, add the following code to a module and run the sub DispatchTotalsByPNNumber()
.
Option Explicit
Sub DispatchTotalsByPNNumber()
Dim LastPN As Long
LastPN = Sheets("RawData").Range("A1").End(xlDown).Row
GetDistinctListOfPNNumbers (LastPN)
GetQuantityTotalsForEachPNNumber (LastPN)
End Sub
Sub GetDistinctListOfPNNumbers(ByVal LastPN As Long)
Sheets("PNTotals").Cells.Clear
Sheets("RawData").Range("A2:A" & LastPN).Copy Sheets("PNTotals").Range("A1")
Sheets("PNTotals").Range("a:a").RemoveDuplicates Columns:=1, Header:=xlNo
End Sub
Function DescCols(ByVal LastPN As Long) As Integer
Dim i As Integer
For i = 2 To 10 ' If you ever have more than 9 description columns, increase range here
If Not IsNumeric(Cells(Cells(LastPN + 1, i).End(xlUp).Row, i)) Then
DescCols = DescCols + 1
Else
Exit Function
End If
Next i
End Function
Sub GetQuantityTotalsForEachPNNumber(ByVal LastPN As Long)
Dim i As Long
Dim x As Integer
Dim TotCols As Integer
Dim PNN As String
Dim ThisColumn As String
Dim PNCount As Integer
TotCols = Sheets("RawData").Range("A1").End(xlToRight).Column
PNCount = 1
' get count of PN#s if there are more than 1
If Sheets("PNTotals").Range("A2").Value <> "" Then
PNCount = Sheets("PNTotals").Range("a1").End(xlDown).Row
End If
For i = 1 To PNCount
PNN = Sheets("PNTotals").Range("A" & i).Value
Sheets("RawData").Select
Sheets("RawData").Range("A1").Select
Sheets("RawData").Cells.Find(What:=PNN, after:=ActiveCell, searchorder:=xlByRows).Activate
' Copy description text from first instance of pn to total sheet for all description columns
For x = 1 To DescCols(LastPN)
Sheets("PNTotals").Cells(i, x + 1).Value = ActiveCell.Offset(, x).Value
Next
For x = x + 1 To TotCols
ThisColumn = GetColumnLetter(x)
' set sumif formulas for however many quantity columns we have
Sheets("PNTotals").Range(ThisColumn & i).Formula = "=SUMIF(RawData!A2:" & ThisColumn & LastPN & ",PNTotals!A" & i & ",RawData!" & ThisColumn & "2:" & ThisColumn & LastPN & ")"
Next
Next
End Sub
Function GetColumnLetter(ByVal ColNum As Integer) As String
GetColumnLetter = Left(ActiveSheet.Cells(1, ColNum).Address(False, False), (ColNum <= 26) + 2)
End Function
注释::假定原始数据从RawData表的单元格A1开始,并且没有任何空白的PN#.如果有空白,则需要以其他方式确定最后一个PN行.
NOTES: Assumes raw data starts in cell A1 of the RawData sheet and that there aren't any blank PN#s. If there are blanks, you'll need to determine the last PN row differently.
这篇关于使用VBA Excel将具有相似值的表行合并的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!