求大神幫助，如何利用字典做到處理批量資料合并(不只范例中14筆, 是動態資料), 部分資料保持一樣, 部分要加上斜線append在同一儲存框
上面的是原生資料
下面的是合并規則是根據 -> A高鐵站 & E車型種類 & F別號是一樣
A高鐵站 & E車型種類 & F別號是一樣的情況下 -> B趟 相加 ; C票價 相加 ; D 發車準時率 取最高值 ; G備注 加上斜線append在同一儲存框
[A1:G1]格是要保持一樣
求大神了
uj5u.com熱心網友回復：
字什么典啊，這是經典的資料透視表的場景uj5u.com熱心網友回復：
現在誰還在使用字典，直接操作Excel 或 使用ADO操作Excel都比較簡單，你的這個問題，用上述方法操作，應該沒有問題。uj5u.com熱心網友回復：
Option Explicit
Sub merget()
Application.ScreenUpdating = False
Dim dic As Object
Dim rng As Range
Set dic = CreateObject("scripting.dictionary")
Set rng = Worksheets("Sheet1").UsedRange
Dim i As Integer, j As Integer
Dim key As String
Dim row As Integer, krow As Integer
row = 1
Dim findStr As Integer
For i = 1 To rng.Rows.Count
key = rng.Cells(i, 1).Value & rng.Cells(i, 6).Value
'Debug.Print key
If key = "" Then GoTo LINE
If (dic.exists(key)) Then
krow = dic(key)
Cells(krow, 2).Value = Val(Cells(krow, 2).Value) + Val(rng(i, 2).Value)
Cells(krow, 3).Value = Val(Cells(krow, 3).Value) + Val(rng(i, 3).Value)
findStr = InStr(Cells(krow, 7).Value, rng(i, 7).Value)
If findStr = 0 Then
If StrComp(Cells(krow, 7).Value, rng(i, 7).Value) < 0 Then
Cells(krow, 7).Value = Cells(krow, 7).Value & "/" & rng(i, 7).Value
Else
Cells(krow, 7).Value = rng(i, 7).Value & "/" & Cells(krow, 7).Value
End If
End If
Else
dic.Item(key) = row
rng(i, 1).Resize(1, 7).Copy
Range(Cells(row, 1), Cells(row, 7)).PasteSpecial xlPasteValuesAndNumberFormats
row = row + 1
End If
LINE:
Next i
Application.ScreenUpdating = True
End Sub
轉載請註明出處，本文鏈接：https://www.uj5u.com/gongcheng/7322.html
標籤：VBA
上一篇：為什么StdDSet.成績表Row顯示未定義型別？oldScRow又是未宣告？這個oldScRow=....這個該怎么寫呀？