[英]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.