错误为“下标超出范围”

Question

VBA编程的新手，请帮助我获得解决方案。

我的代码必须接受用户定义的excel文件，并将这些单元格的值作为彩色的日志记录。我收到“下标超出范围”错误

Public color_Change, color_Recall
Private Sub CommandButton1_Click()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Dim rcell As Range
    Dim CellData As String
    Dim fso As FileSystemObject

    Set fso = New FileSystemObject

    Dim stream As TextStream
    Set stream = fso.OpenTextFile("D:\Support.log", ForWriting, True)
    CellData = ""

    Dim vaFiles As Variant
    vaFiles = Application.GetOpenFilename()
    ActiveSheet.Range("B10") = vaFiles

    Set wb = Workbooks.Open(vaFiles)

    For Each vaFiles In ActiveWorkbook.Worksheets
        Worksheets(vaFiles.Name).Activate
        stream.WriteLine "The name of the Tab Sheet is :" & vaFiles.Name
        color_Change = getRGB2("A1")
        'color_Recall = getRGB2("A2")
        For Each rcell In vaFiles.UsedRange.Cells
            arrcolor = color_Change
            rcell.Interior.Color = getRGB1("A3")
            For Each color_Recall In ActiveSheet.UsedRange
                If rcell.Interior.Color = arrcolor Then
                CellData = Trim(rcell.Value)
                stream.WriteLine "The Value at location (" & rcell.Row & "," & rcell.Column & ") " & CellData & " " & rcell.Address
            End If
        'End If
        Next
    Next
    stream.WriteLine vbCrLf
    'Next
    'Next
    stream.Close
    MsgBox ("Job Done")
End Sub

Function getRGB2(ccell) As String
    Dim wkb As Workbook

    ThisWorkbook.Sheets(Sheet).Activate
    'wkb.Activate
    Dim i As Integer, rng As Range
    Dim r As Byte, g As Byte, B As Byte

    Set rng = Range(ccell)
    With rng.Interior
        r = .Color Mod 256
        g = .Color \ 256 Mod 256
        B = .Color \ (CLng(256) * 256)
    End With
    getRGB2 = r & "," & g & "," & B
End Function

Function getRGB1(ccell) As String
    Dim wkb As Workbook

    ThisWorkbook.Sheets(Sheet).Activate
    'wkb.Activate
    Dim i As Integer, rng As Range
    Dim r As Byte, g As Byte, B As Byte

    Set rng = Range(ccell)
    With rng.Interior
        r = .Color Mod 256
        g = .Color \ 256 Mod 256
        B = .Color \ (CLng(256) * 256)
    End With
    getRGB1 = r & "," & g & "," & B
End Function

Answer 1

我无法复制您的错误，但：

1. 您不需要Activate表，如果您符合getRGB1和getRGB2函数的资格，则getRGB1 getRGB2工作表
2. 您有第二个循环查看似乎没有任何作用的所有单元格（ color_Recall ）

建议

For Each vafiles In ActiveWorkbook.Worksheets
    stream.WriteLine "The name of the Tab Sheet is :" & vafiles.Name
    color_Change = getRGB2(vafiles.Range("A1"))
        For Each rcell In vafiles.UsedRange.Cells
            arrcolor = color_Change
            rcell.Interior.Color = getRGB1(vafiles.Range("A3"))
            If rcell.Interior.Color = arrcolor Then
                 CellData = Trim(rcell.Value)
                  stream.WriteLine "The Value at location (" & rcell.Row & "," & rcell.Column & ") " & CellData & " " & rcell.Address
            End If
        Next
Next

Answer 2

Subs和Function之间的根本区别是

• 潜艇可以在物体上工作
• Sub没有返回值
• 函数不能更改对象

• 函数通常会在您调用时返回某些内容

   ThisWorkbook.Sheets(Sheet).Activate 

  您正在尝试更改不允许的工作簿对象。

我也不确定ThisWorkbook.Sheets（Sheet）是有效的对象，除非您已将Sheet定义为全局变量。

Google搜索

获得RGB颜色Excel

将此作为最高结果

Function getRGB2(rcell) As String
Dim C As Long
Dim R As Long
Dim G As Long
Dim B As Long

    C = rcell.Interior.Color
    R = C Mod 256
    G = C \ 256 Mod 256
    B = C \ 65536 Mod 256
    getRGB2 = R & "," & G & "," & B
End Function

来自http://excel.tips.net/T010179_Determining_the_RGB_Value_of_a_Color.html

Answer 3

Function getRGB2(ccell) As String
Dim wkb As Workbook

ThisWorkbook.Sheets(Sheet).Activate

而是尝试这样：

Function getRGB2(ccell) As String
Dim wkb As Workbook ' or rename this to Dim ThisWorkbook As Workbook
Set wkb = ActiveWorkbook ' or rename this to Set ThisWorkbook = ActiveWorkbook
wkb.Sheets("Name of the sheet you want").Activate ' or rename this to ThisWorkbook.Sheets("Name of the sheet you want").Activate

我认为您的问题是，您还没有清除wkb / ThisWorkbook的名称，您已经告诉它变暗的变量，但是您什么都没做，您需要告诉代码哪个可以工作预定要使用的书，之后可以在代码中使用它。

希望这可以帮助

如果您不明白我的意思，我会详细解释。