如何对VBA进行编码以根据字体颜色粘贴值或公式? [英] How to code VBA to paste values or formulas based on font color?

问题描述

VBA还是新手，需要帮助来修改一些现有代码.

新代码中需要出现几个IF语句:如果复制的字体为绿色，请粘贴为值并将字体颜色从绿色更改为蓝色.如果复制的字体不是绿色，请粘贴为公式.

Sub InvestorModelMacro()

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
DisplayGridlines = False

Dim r As Range, ws As Worksheet

For Each r In Worksheets("Asset Dashboard").Range("C6:C9")   'go through each cell in DV list
    If Len(r) > 0 Then                                       'only do something if cell not empty
       Worksheets("Live").Range("D3").Value = r.Value        'transfer value to cell D3 of 'Live' tab
       Application.Calculate
       Set ws = Worksheets.Add                               'add new sheet
       ws.Name = Worksheets("Investor Model").Range("D3")    'renames new sheet after selected asset
       Worksheets("Investor Model").Cells.Copy
       ws.Range("A1").PasteSpecial xlValues                   'copy values only from Investor Model to new sheet
       ws.Range("A1").PasteSpecial xlFormats                 'copy formats only from Investor Model to new sheet
       ActiveWindow.DisplayGridlines = False                 'turns off gridlines

End If
Next r

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True


End Sub

不幸的是，下面的代码仍在返回粘贴到新工作表中的所有单元格的公式.我需要将绿色字体粘贴为值，并将所有其他字体颜色保留为公式...

 Sub InvestorModelMacro()

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
DisplayGridlines = False

Dim r As Range, ws As Worksheet

For Each r In Worksheets("Asset Dashboard").Range("C6:C9")   'go through each cell in DV list
    If Len(r) > 0 Then                                       'only do something if cell not empty
       Worksheets("Live").Range("D3").Value = r.Value        'transfer value to cell D3 of 'Live' tab
       Application.Calculate
       Set ws = Worksheets.Add                               'add new sheet
       ws.Name = Worksheets("Investor Model").Range("D3")    'renames new sheet after selected asset
    If r.Font.Color = RGB(0, 153, 0) Then
        r.Copy
        Range("A1").PasteSpecial xlPasteValues
        Range("A1").Font.Color = RGB(0, 153, 0)
    Else
        r.Copy
        Range("A1").PasteSpecial xlPasteFormulas
        Range("A1").Font.Color = RGB(0, 0, 255)
    End If
       Worksheets("Investor Model").Cells.Copy
       ws.Range("A1").PasteSpecial xlFormulas                'copy values only from Investor Model to new sheet
       ws.Range("A1").PasteSpecial xlFormats                 'copy formats only from Investor Model to new sheet
       ActiveWindow.DisplayGridlines = False                 'turns off gridlines

End If
Next r

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True


End Sub 

解决方案

要使用颜色进行此操作，您要访问Font.ColorIndex属性.

您将需要弄清楚哪种颜色索引号与您的工作表上使用的任何绿色阴影以及您要使用的任何蓝色阴影有关，并将它们包含在下面的代码中

---

伪代码:

For Each R in xRange
    If Len(R) > 0 Then
        If R.Font.Color = [Green Font Index #] Then
            R.Copy
            Range("?").PasteSpecial xlPasteValues
            Range("?").Font.Color = [Blue Font Index #]
        Else
            R.Copy
            Range("?").PasteSpecial xlPasteFormulas
            Range("?").Font.Color = [What color do you want here?]
        End If
    End If
Next R

---

我个人更希望不要在这里将颜色用作逻辑驱动器.如果工作表上存在某些逻辑来确定单元格字体为宏之前的颜色(类似于条件格式)，那么最好在此处重新创建该逻辑

Still new to VBA and need help modifying some existing code.

Several IF statements need to occur in the new code: If copied font is green, paste as values and change font color from green to blue. If copied font is anything other than green, paste as formulas.

Sub InvestorModelMacro()

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
DisplayGridlines = False

Dim r As Range, ws As Worksheet

For Each r In Worksheets("Asset Dashboard").Range("C6:C9")   'go through each cell in DV list
    If Len(r) > 0 Then                                       'only do something if cell not empty
       Worksheets("Live").Range("D3").Value = r.Value        'transfer value to cell D3 of 'Live' tab
       Application.Calculate
       Set ws = Worksheets.Add                               'add new sheet
       ws.Name = Worksheets("Investor Model").Range("D3")    'renames new sheet after selected asset
       Worksheets("Investor Model").Cells.Copy
       ws.Range("A1").PasteSpecial xlValues                   'copy values only from Investor Model to new sheet
       ws.Range("A1").PasteSpecial xlFormats                 'copy formats only from Investor Model to new sheet
       ActiveWindow.DisplayGridlines = False                 'turns off gridlines

End If
Next r

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True


End Sub

Unfortunately, the code below is still returning formulas for all cells pasted into new worksheets. I need the green font to be pasted as values, and all other font colors to remain as formulas...

Sub InvestorModelMacro()

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
DisplayGridlines = False

Dim r As Range, ws As Worksheet

For Each r In Worksheets("Asset Dashboard").Range("C6:C9")   'go through each cell in DV list
    If Len(r) > 0 Then                                       'only do something if cell not empty
       Worksheets("Live").Range("D3").Value = r.Value        'transfer value to cell D3 of 'Live' tab
       Application.Calculate
       Set ws = Worksheets.Add                               'add new sheet
       ws.Name = Worksheets("Investor Model").Range("D3")    'renames new sheet after selected asset
    If r.Font.Color = RGB(0, 153, 0) Then
        r.Copy
        Range("A1").PasteSpecial xlPasteValues
        Range("A1").Font.Color = RGB(0, 153, 0)
    Else
        r.Copy
        Range("A1").PasteSpecial xlPasteFormulas
        Range("A1").Font.Color = RGB(0, 0, 255)
    End If
       Worksheets("Investor Model").Cells.Copy
       ws.Range("A1").PasteSpecial xlFormulas                'copy values only from Investor Model to new sheet
       ws.Range("A1").PasteSpecial xlFormats                 'copy formats only from Investor Model to new sheet
       ActiveWindow.DisplayGridlines = False                 'turns off gridlines

End If
Next r

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True


End Sub

解决方案

To do this with colors you want to access the Font.ColorIndex property.

You will need to figure out what Color Index # relates to whatever shade of Green is being used on your sheet as well as whatever shade of Blue you want to use and sub them in the code below

---

Pseudo code:

For Each R in xRange
    If Len(R) > 0 Then
        If R.Font.Color = [Green Font Index #] Then
            R.Copy
            Range("?").PasteSpecial xlPasteValues
            Range("?").Font.Color = [Blue Font Index #]
        Else
            R.Copy
            Range("?").PasteSpecial xlPasteFormulas
            Range("?").Font.Color = [What color do you want here?]
        End If
    End If
Next R

---

I would personally prefer to not use colors as the logic driver here. If there is some logic that exists on the sheet that determines what colors the cells fonts are pre-macro (something like conditional formatting), you may be better off recreating that logic here

这篇关于如何对VBA进行编码以根据字体颜色粘贴值或公式?的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！