excel 循环遍历单元格并移动列

py49o6xq 于 2023-03-31 发布在其他

关注(0)|答案(1)|浏览(200)

我有一个VBA代码，它评估了单元格的数量，并根据表改变了它们的字体颜色。
我可以在一列内完成，但我需要遍历整个表。
我不知道如何在“B变成C”等列之间移动。
如果我为每一个列使用逻辑，我会很难分配应该是艾德（？）
有什么线索吗？

Sub AddColours()

Dim TPrange As Range
Dim LR As Long
Dim Vlookup As String
Dim Colour As String
Dim CLR As Range
Dim FC As String
Dim LR_of_AJM As Integer
Dim COL As String


LR = Sheet2.Cells(Rows.Count, 2).End(xlUp).Row
B = 1
A = 1
c = 4 'first line of lookup text
x = Sheet2.Rows.Count

' counts last row

For Each Column In Sheet4.Range("b:G").Columns

LR_of_AJM = Sheet2.UsedRange.Rows(Sheet4.UsedRange.Rows.Count).Row
COL = Sheet4.UsedRange.Columns(Sheet4.UsedRange.Columns.Count).Column

Do While c < Sheet4.Range("a1")  'LR_of_AJM - 6 needs to be replaced by LR_of_AJM to do full loop

Sheet4.Activate
Set TPrange = Sheet2.Range("B2:Z" & LR)
'==================================

Set CLR = Sheet4.Range("b" & c)

'===========================================

Set CTP = Sheet3.Range("a1:b10")

On Error Resume Next
Colour = Application.WorksheetFunction.Vlookup(CLR, TPrange, 2, False)

FC = Application.WorksheetFunction.Vlookup(Colour, CTP, 2, False)

CLR.Select

 With Selection.Font
    If FC = "Red" Then
        Selection.Font.Color = vbRed
        ElseIf FC = "Blue" Then
        Selection.Font.Color = vbBlue
         ElseIf FC = "Yellow" Then
        Selection.Font.Color = vbYellow
         ElseIf FC = "Green" Then
        Selection.Font.Color = vbGreen
       
        Else: Selection.Interior.Color = vbBlack
              End If
              
    End With

c = c + 1

Loop

'MsgBox "It has matched " & LR & " rows from Touchpoints sheet"

Next

End Sub

excel

来源：https://stackoverflow.com/questions/75879499/loop-through-cells-and-move-columns

1条答案

按热度按时间

oxiaedzo1#

如果我理解正确的话，你的情况就像下面的图片：

预期结果：

下面的代码使用find方法而不是vlookup。

Sub test()
Dim LR As Integer
Dim CTP As Range, TPrange As Range, CLR As Range, cell As Range
Dim arrColor: Dim c as range: Dim d as range

arrColor = Array("Red", vbRed, "Blue", vbBlue, "Green", vbGreen, "Yellow", vbYellow)

LR = 7
Set CTP = Sheet3.Range("a1:b10")
Set TPrange = Sheet2.Range("B2:Z" & LR)
Set CLR = Sheet4.Range("B4:D7")

For Each cell In TPrange.Columns(1).Cells
    Set c = CLR.Find(cell.Value, lookat:=xlWhole)
    Set d = CTP.Find(cell.Offset(0, 1).Value, lookat:=xlWhole)
    If Not c Is Nothing And Not d Is Nothing Then
        With CLR
            .Replace cell.Value, True, xlWhole, , False, , False, False
            Set rgR = .SpecialCells(xlConstants, xlLogical)
            .Replace True, cell.Value, xlWhole, , False, , False, False
        End With
        rgR.Font.Color = arrColor(Application.Match(d.Offset(0, 1), arrColor, False))
    End If
Next

End Sub

它创建数组中的颜色项作为arrColor变量。
由于您使用的是vlookup，逻辑上TPRange列1中的行是唯一值。因此它将TPRange列1中的每个单元格作为单元格变量循环，检查循环单元格是否在CLR范围内找到，并且循环单元格.offset（0，1）是否在CTP范围内找到，然后将颜色（通过使用match方法获取arrColor中的索引号）应用于所有单元格，其值是CLR范围内的循环单元格值。

赞(0）回复(0）举报 2023-03-31

我来回答

excel 循环遍历单元格并移动列

1条答案

相关问题

热门标签

最新问答