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

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

如果您符合Activate和getRGB1功能

getRGB2

您有第二个循环查看似乎没有任何用途的所有单元格（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可以处理对象
Sub没有返回值
功能无法更改对象
函数通常会返回一些东西当你打电话
```
ThisWorkbook.Sheets(Sheet).Activate
```
您正在尝试更改不允许使用的工作簿对象。

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

Google搜索

获取rgb color 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将会是什么，你已经告诉它可能会变暗，但你没有做任何事情，你需要告诉它您希望它使用的工作簿代码，之后您可以在代码中使用它。

希望这有帮助

如果你不明白我的意思，那么如果可以，我会更详细地解释。

错误为“下标超出范围”

3 个答案: