[英]Set dynamic Range according to cell color / VBA
我正在嘗試匯總自動生成的數據,並將其放入這樣的格式。
我在其中添加了紅色單元格,以便它們可以幫助我設置從工作表中提取數據所需的范圍。 目的是設置一個范圍,從帶數字的單元格到下一個紅色單元格(在圖像中為數字3構架為A)。 到目前為止,我只是將范圍一直放在最上面的單元格上,但這導致了數據傳輸中的許多錯誤。 該代碼如下所示:
For Each C In copyRng
Set colSrc = C.EntireRow.Offset(0).Cells(1)
If IsNumeric(C) And C.Value <> "0" And Len(C) <> 0 And C.Value < 2010 And InStr(1, colSrc, "Total") = 0 Then
Set rowRange = xSheet.Range(C, C.EntireColumn.Cells(1))
For Each q In rowRange
If InStr(1, q.Value, "C-") Then
Set rowSrc = q
Set colSrc = C.EntireRow.Offset(0).Cells(1)
Set yearSrc = q.EntireRow.Offset(-1).Cells(3)
Set qtrSrc = q.EntireRow.Offset(-1).Cells(2)
Set exchSrc = q.EntireRow.Offset(-1).Cells(1)
End If
Next q
是否可以設置這樣的范圍,還是我應該嘗試尋找另一種方法。 最終目標是找出在數字上方以C-開頭的帳號,並忽略在其上方具有“總計”的任何數字。
我想出了另一種方式。 我沒有按顏色設置范圍,而是設置了2個范圍,並使用第一個范圍將第二個范圍設置為適當的大小。 代碼看起來像這樣。 如果我的第一個想法仍然可行,我將非常感興趣。
For Each C In copyRng
Set colSrc = C.EntireRow.Offset(0).Cells(1)
If IsNumeric(C) And C.Value <> "0" And Len(C) <> 0 And C.Value < 2010 And InStr(1, colSrc, "Total") = 0 Then
Set SetRange = xSheet.Range(C, C.EntireColumn.Cells(1))
For Each k In SetRange
If InStr(1, k.Value, "C-") Or InStr(1, k.Value, "Total") Then Set setSource = k
Next k
Set rowRange = xSheet.Range(C, setSource)
For Each q In rowRange
If InStr(1, q.Value, "C-") Then
Set rowSrc = q
Set colSrc = C.EntireRow.Offset(0).Cells(1)
Set yearSrc = q.EntireRow.Offset(-1).Cells(3)
Set qtrSrc = q.EntireRow.Offset(-1).Cells(2)
Set exchSrc = q.EntireRow.Offset(-1).Cells(1)
numCol = DestSh.Cells.Find(colSrc.Value, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Column
For Each u In DestSh.Range("A1:A548")
If rowSrc = u And yearSrc = u.Offset(0, 2) And exchSrc = u.Offset(0, 1) And qtrSrc = u.Offset(0, 3) Then numRow = u.Row
Next u
C.Interior.ColorIndex = 4
Set destRng = DestSh.Cells(numRow, numCol)
C.Copy destRng
ElseIf InStr(1, q.Value, "Total") Then Exit For
End If
Next q
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.