如何在Excel VBA中存储范围内每个单元格的填充和字体颜色

huangapple
go评论105阅读模式
英文:

How to store fill and font color of every cell in a range in Excel VBA

问题

当我从数据库刷新数据时，新添加行时任何填充/字体颜色都会移动。我想要在我的刷新宏中添加以下步骤：

  1. 存储当前填充/字体颜色信息
  2. 清除所有颜色
  3. 刷新数据
  4. 重新应用正确的颜色到单元格

这是我当前的代码，用于处理手动笔记列的相同操作：

  1.     plannerData = plannerSheet.Range("A3:BO" & CStr(lastRowPlanner))
  2.     historyData = historySheet.Range("A2:BO" & CStr(lastRowHistory))
  3.     lastRowPlannerData = UBound(plannerData, 1)
  4.     lastRowHistoryData = UBound(historyData, 1)
  6.     For plannerRow = 1 To lastRowPlannerData
  7.         plannerValue = plannerData(plannerRow, 4) '获取工作订单号
  8.         
  9.         For historyRow = 1 To lastRowHistoryData
  10.             historyValue = historyData(historyRow, 4) '检查此行中的工作订单号
  11.             
  12.             If plannerValue = historyValue Then 
  13.                 For i = LBound(columnsToCopy) To UBound(columnsToCopy)
  14.                     plannerData(plannerRow, columnsToCopy(i)) = historyData(historyRow, columnsToCopy(i))
  15.                 Next i
  16.                 
  17.                 Exit For '无需继续搜索历史数据，转到下一个计划者行
  18.                 
  19.             End If
  20.             
  21.         Next historyRow
  22.     
  23.     Next plannerRow
  24.     
  25.     '现在我们已经在内存中恢复了计划者数据
  26.     '我们可以相应地重置计划者电子表格
  27.     plannerSheet.Range("A3:BO" & CStr(lastRowPlanner)).Value = plannerData

我不确定是否可以修改此代码以处理颜色，因为当前它只处理文本。

英文:

When I refresh the data from my database, any fill/font color gets moved when new rows are added. I want to add to my refresh macro

  1. Store current fill/font color information
  2. Clear it all
  3. Refresh data
  4. reapply colors to proper cells

This is my current code that does the same thing with my manual notes columns

  1.     plannerData = plannerSheet.Range("A3:BO" & CStr(lastRowPlanner))
  2.     historyData = historySheet.Range("A2:BO" & CStr(lastRowHistory))
  3.     lastRowPlannerData = UBound(plannerData, 1)
  4.     lastRowHistoryData = UBound(historyData, 1)
  7.     For plannerRow = 1 To lastRowPlannerData
  8.         plannerValue = plannerData(plannerRow, 4) 'get the work order number
  9.         
  10.         For historyRow = 1 To lastRowHistoryData
  11.             historyValue = historyData(historyRow, 4) 'check the work order number in this row
  12.             
  13.             If plannerValue = historyValue Then 
  14.                 For i = LBound(columnsToCopy) To UBound(columnsToCopy)
  15.                     plannerData(plannerRow, columnsToCopy(i)) = historyData(historyRow, columnsToCopy(i))
  16.                 Next i
  17.                 
  18.                 Exit For 'no need to keep searching the history, move on to the next planner row
  19.                 
  20.             End If
  21.             
  22.         Next historyRow
  23.     
  24.     Next plannerRow
  25.     
  26.     'so now we have restored planner data in memory
  27.     'we can reset the planner spreadsheet accordingly
  28.     plannerSheet.Range("A3:BO" & CStr(lastRowPlanner)).Value = plannerData

I'm not sure if I can modify this code to work with the colors since currently it's just dealing with text

答案1

得分: 1

  1. Dim i As Long    
  2. Dim fillColor() As Variant
  3. Dim fillColorDimension As Long
  5. fillColorDimension = 0
  6. For Each cell In plannerSheet.Range("A3:BT" & lastRowPlanner)
  7.     If cell.Interior.Color <> 16777215 Then
  8.         fillColorDimension = fillColorDimension + 1
  9.     End If
  10. Next cell
  12. If fillColorDimension <> 0 Then
  13.     i = 1
  14.     ReDim fillColor(1 To fillColorDimension, 1 To 3)
  15.     For Each cell In plannerSheet.Range("A3:BT" & lastRowPlanner)
  16.         If cell.Interior.Color <> 16777215 Then
  17.             cellRow = cell.Row
  18.             fillColor(i, 1) = plannerSheet.Range("D" & cellRow).Value
  19.             fillColor(i, 2) = cell.Column
  20.             fillColor(i, 3) = cell.Interior.Color
  21.             i = i + 1
  22.         End If
  23.     Next cell
  24. End If
  26. ThisWorkbook.RefreshAll
  28. For colorRow = 1 To fillColorDimension
  29.     For Each cell In plannerSheet.Range("D3:D" & lastRowPlanner)
  30.         If cell = fillColor(colorRow, 1) Then
  31.             plannerSheet.Cells(cell.Row, fillColor(colorRow, 2)).Interior.Color = fillColor(colorRow, 3)
  32.         End If
  33.     Next cell
  34. Next colorRow
英文: 
  1. Dim i As Long    
  2. Dim fillColor() As Variant
  3. Dim fillColorDimension As Long
  5. fillColorDimension = 0
  6. For Each cell In plannerSheet.Range(&quot;A3:BT&quot; &amp; lastRowPlanner)
  7.     If cell.Interior.Color &lt;&gt; 16777215 Then
  8.      fillColorDimension = fillColorDimension + 1
  9.     End If
  10. Next cell
  12. If fillColorDimension &lt;&gt; 0 Then
  13.     i = 1
  14.     ReDim fillColor(1 To fillColorDimension, 1 To 3)
  15.     For Each cell In plannerSheet.Range(&quot;A3:BT&quot; &amp; lastRowPlanner)
  16.         If cell.Interior.Color &lt;&gt; 16777215 Then
  17.             cellRow = cell.Row
  18.             fillColor(i, 1) = plannerSheet.Range(&quot;D&quot; &amp; cellRow).Value
  19.             fillColor(i, 2) = cell.Column
  20.             fillColor(i, 3) = cell.Interior.Color
  21.             i = i + 1
  22.         End If
  23.     Next cell
  24. End If
  26. ThisWorkbook.RefreshAll
  28. For colorRow = 1 To fillColorDimension
  29.     For Each cell In plannerSheet.Range(&quot;D3:D&quot; &amp; lastRowPlanner)
  30.         If cell = fillColor(colorRow, 1) Then
  31.             plannerSheet.Cells(cell.Row, fillColor(colorRow, 2)).Interior.Color = fillColor(colorRow, 3)
  32.         End If
  33.     Next cell
  34. Next colorRow

My workbook is 72 columns long and I tested it with ~700 rows. If all 50,400 cells have a fill color, this takes about 25 seconds. Considering my users will likely not be highlighting more than 10% of those cells, it should be much faster than that.

I use column D because that is where the work order number is stored. This acts as a primary key for the data. If a data set does not have a unique key like this, it would need an artificial one. This, i believe, is usually done with an index(?)

Also, this does not copy the fill colors to the history sheet. The history sheets main point was to track WOs that fell off after refresh because of closure, and tracking their notes on those was important. Colors, not so much. But the same process could be applied to copy colors from the planner sheet to the history sheet

huangapple
  • 本文由 发表于 2023年6月15日 05:51:31
  • 转载请务必保留本文链接：https://go.coder-hub.com/76477806.html
  • arrays
  • colors
  • excel
  • fill
  • vba
匿名

发表评论

匿名网友

:?: :razz: :sad: :evil: :!: :smile: :oops: :grin: :eek: :shock: :???: :cool: :lol: :mad: :twisted: :roll: :wink: :idea: :arrow: :neutral: :cry: :mrgreen:

确定