我正在嘗試根據列標題將資料從一張表傳輸到另一張表，代碼作業正常，但我需要進行一個更改，如果有任何列具有顏色索引-RGB（237,125,49），那么不要復制該列的資料。舊作業表是源作業表，而 sheet1 是目標作業表。
Option Explicit
Sub Transfer()
Dim wb As Workbook: Set wb = ThisWorkbook
Dim sws As Worksheet: Set sws = wb.Worksheets("Old Sheet")
Dim sdrg As Range
Dim shData() As Variant
Dim srCount As Long
Dim scCount As Long
Dim dws As Worksheet
Dim drg As Range
Dim dhData() As Variant
Dim dcCount As Long
Dim dc As Long
Dim dHeader As String
Set dws = wb.Worksheets("Sheet1")
With sws.Range("A1").CurrentRegion
shData = .Rows(1).Value
srCount = .Rows.Count - 1
scCount = .Columns.Count
Set sdrg = .Resize(srCount).Offset(1)
End With
Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
dict.CompareMode = vbTextCompare
Dim sc As Long
For sc = 1 To scCount
dict(CStr(shData(1, sc))) = sdrg.Columns(sc).Value
Next sc
With dws
If Not dws Is sws Then
With dws.Range("A1").CurrentRegion
dhData = .Rows(1).Value
dcCount = .Columns.Count
Set drg = .Resize(srCount).Offset(.Rows.Count)
End With
For dc = 1 To dcCount
dHeader = CStr(dhData(1, dc))
If dict.Exists(dHeader) Then
drg.Columns(dc).Value = dict(dHeader)
End If
Next dc
End If
End With
End Sub
請幫我解決這個問題。
uj5u.com熱心網友回復：
我沒有檢查你的整個代碼，只是填充了 dict 變數的部分。如果您的目標是跳過第一個單元格RGB(237, 125, 49)著色的列，那么這將是一個解決方案
For sc = 1 To scCount
If sdrg.Columns(sc).Cells(1, 1).Offset(-1).Interior.Color <> RGB(237, 125, 49) Then
dict(CStr(shData(1, sc))) = sdrg.Columns(sc).Value
End If
Next sc
轉載請註明出處，本文鏈接：https://www.uj5u.com/qiye/515447.html
標籤：擅长vbavba7
下一篇：VBA如何在函式中設定表單