返回列表 上一主題 發帖

[發問] vlookup合并的資料

本帖最後由 singo1232001 於 2023-12-21 02:42 編輯

回復 3# 198188

代碼需放在工作表模組  不要放在Module1


    Dim OUT1
Private Sub Worksheet_Change(ByVal Target As Range)
If OUT1 = True Then Exit Sub
If Target.Height > 10000 Then Exit Sub
If Target.Width > 10000 Then Exit Sub
If Target.Count > 1 Then Exit Sub
If Target.Value = "" Then Exit Sub
If Target.Row > 1 Then Exit Sub
If Target.Column = 11 Then
ElseIf Target.Column = 14 Then
ElseIf Target.Column = 17 Then
ElseIf Target.Column = 20 Then
Else
Exit Sub
End If
OUT1 = True
Target.Offset(1, 0).Resize(100000, 2).ClearContents
OUT1 = False
r = Cells(Rows.Count, 1).End(3).Row
For i = 2 To r
If UCase(Target.Value) = UCase(Cells(i, 3).Value) Then
OUT1 = True
For j = i To Cells(i, 3).MergeArea.Count + i - 1
w = w + 1
Target.Offset(w, 0).Resize(1, 2).Value = Cells(j, 4).Resize(1, 2).Value
sumx = sumx + Cells(j, 5)
Next
End If
Next
If w <> 0 Then Target.Offset(w + 1, 0).Resize(1, 2) = Array("Total", sumx)
OUT1 = False
End Sub

TOP

回復 7# 198188


    之前的代碼 是在k1打字就會直接觸發操作

若想要打完再手動執行用如下代碼
Sub test()
r = Cells(Rows.Count, 1).End(3).Row
Range("k2:u1000").ClearContents
For Each Z In Range("K1,N1,Q1,T1")
t5 = 0: t4 = 0
If Z.Value <> "" Then
    For i = 2 To r
    If UCase(Z.Value) = UCase(Cells(i, 3).Value) Then
        For j = i To Cells(i, 3).MergeArea.Count + i - 1
        t4 = t4 & "▲" & Cells(j, 4)
        t5 = t5 & "▲" & Cells(j, 5)
        tsum = tsum + Cells(j, 5)
        Next
    End If
    Next
   
    a4 = Split(Mid(t4 & "▲Total", 3, 9999), "▲")
    a5 = Split(Mid(t5 & "▲" & tsum, 3, 9999), "▲")
   
    If UBound(a4) > 0 Then
    Z.Offset(1, 0).Resize(UBound(a4) + 1, 1) = Application.Transpose(a4)
    Z.Offset(1, 1).Resize(UBound(a4) + 1, 1) = Application.Transpose(a5)
    End If
End If
Next

End Sub

TOP

GPT4
在您提供的圖片中,左側是一個資料列表,右側是一個匯總結果。這個列表似乎是用於追踪庫存或貨架上的物品。貨架序號在某些行是合併的,且合併的行數不固定。您希望能夠像右邊展示的那樣,通過輸入貨架序號,直接將相關資料轉移到右側。

提供的代碼是一個 Excel 宏,用於處理這種類型的資料轉移。代碼進行了如下操作:

確定數據範圍。
清除目標範圍(K2:U1000)的內容。
遍歷特定的列(K1, N1, Q1, T1),這些列似乎是用來指定不同的貨架序號。
對於每個指定的貨架序號,代碼尋找左側列表中所有匹配的行。
將匹配行中的資料複製到右側的相應位置。
計算並添加總數到最後。
注釋您的代碼,以便於理解每一部分的功能:

vb
Copy code
Sub test()
    ' 獲取最後一行的行號
    r = Cells(Rows.Count, 1).End(xlUp).Row
    ' 清除K2到U1000範圍內的所有內容
    Range("k2:u1000").ClearContents
   
    ' 遍歷K1, N1, Q1, T1這四列的單元格
    For Each Z In Range("K1,N1,Q1,T1")
        t5 = 0: t4 = 0 ' 初始化變量
        ' 如果當前單元格有值
        If Z.Value <> "" Then
            ' 遍歷2到最後一行
            For i = 2 To r
                ' 如果當前列的值與C列的值相同(不區分大小寫)
                If UCase(Z.Value) = UCase(Cells(i, 3).Value) Then
                    ' 遍歷合併區域的每一行
                    For j = i To Cells(i, 3).MergeArea.Count + i - 1
                        t4 = t4 & "▲" & Cells(j, 4)
                        t5 = t5 & "▲" & Cells(j, 5)
                        tsum = tsum + Cells(j, 5)
                    Next
                End If
            Next
            
            ' 切割字符串獲取資料數組
            a4 = Split(Mid(t4 & "▲Total", 3, 9999), "▲")
            a5 = Split(Mid(t5 & "▲" & tsum, 3, 9999), "▲")
            
            ' 如果數組有資料
            If UBound(a4) > 0 Then
                ' 將數據填充到指定的單元格區域
                Z.Offset(1, 0).Resize(UBound(a4) + 1, 1) = Application.Transpose(a4)
                Z.Offset(1, 1).Resize(UBound(a4) + 1, 1) = Application.Transpose(a5)
            End If
        End If
    Next
End Sub
請注意,這段代碼是基於假定貨架序號列(C列)的合併區域可以通過 .MergeArea.Count 正確獲得。另外,這段代碼使用了 UCase 函數來進行不區分大小寫的比較。如果您的貨架序號區分大小寫,則不應使用 UCase 函數。

TOP

回復 13# 198188


    切割區隔用而已
可能是big5 轉utf-8異常
把三角型 改成兩個;;好了

TOP

        靜思自在 : 稻穗結得越飽滿,越會往下垂,一個人越有成就,就要越有謙沖的胸襟。
返回列表 上一主題