错误为“下标超出范围”

Am new to VBA Programming Kindly help me in getting the solution.

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

My code has to accept user defined excel files and take those values of the cells as log which are colored.I am getting error as "Subscript Out of range"

我的代码必须接受用户定义的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

3 个解决方案

#1

I can't replicate your error but:

我无法复制你的错误，但是:

1. You don't need to Activate the sheets, you cant loop through the sheets if you qualify the getRGB1 and getRGB2 functions
2. 您不需要激活这些表，如果您限定getRGB1和getRGB2函数，您就不能对这些表进行循环
3. You have a second loop looking at all cells (color_Recall) that doesn't seem to serve any purpose
4. 您有第二个循环来查看似乎没有任何用途的所有单元格(color_Recall)

suggest

建议

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

#2

The fundamental differences between Subs and Functions are

子函数和函数之间的根本区别是

• A Sub can work on objects
• 子对象可以处理对象
• A Sub doesn't have a return value
• 下标没有返回值
• A Function can not change an object
• 函数不能改变一个对象

• A Function will usually return something When you call

  函数在调用时通常会返回一些东西。

  ThisWorkbook.Sheets(Sheet).Activate
  

  You are trying to change the Workbook object which isn't allowed.

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

I'm also not sure that ThisWorkbook.Sheets(Sheet) is a valid object unless you've defined Sheet as a global variable.

我也不确定这个工作簿。sheets(表)是一个有效的对象，除非您已经将它定义为一个全局变量。

A Google search for

谷歌搜索

get rgb color excel

得到的rgb颜色excel

turned up this as the top result

这是最上面的结果

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

From http://excel.tips.net/T010179_Determining_the_RGB_Value_of_a_Color.html

从http://excel.tips.net/T010179_Determining_the_RGB_Value_of_a_Color.html

#3

Function getRGB2(ccell) As String
Dim wkb As Workbook

ThisWorkbook.Sheets(Sheet).Activate

Instead try this:

相反,试试这个:

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

I think what your problem is, is that you haven't decleard what wkb/ThisWorkbook will be, you have told it the varible it will be in the Dim but you have then done nothing with it, you need to tell the code which work book you want it to use, after that you can use it in your code.

我认为你的问题是什么,是你没有decleard wkb / ThisWorkbook会是什么,你告诉它的变量将会暗淡但你又做了什么,你需要告诉工作的书你想要使用的代码,代码中之后,您可以使用它。

Hope this helps

希望这有助于

If you don't understand what I mean comment and i'll explain it in greater detail if I can.

如果你不明白我的意思，我将解释更详细的评论，如果可以的话。