错误为“下标超出范围”

VBA编程新手请帮助我获得解决scheme。

我的代码必须接受用户定义的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函数，则无法在表单中循环
2. 你有第二个循环看所有单元格（ color_Recall ），似乎没有任何用途

build议

 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和Functions之间的根本区别在于

• 一个Sub可以处理对象
• Sub没有返回值
• 一个函数不能改变一个对象

• 一个函数通常会返回一些东西，当你打电话

   ThisWorkbook.Sheets(Sheet).Activate 

  您正在尝试更改不允许的Workbook对象。

我也不确定ThisWorkbook.Sheets（工作表）是一个有效的对象，除非你已经将Sheet定义为一个全局variables。

Googlesearch

得到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将会是什么，你已经告诉它它将在Dim中的variables，但是你没有做任何事情，你需要告诉代码哪些工作您希望使用的书，然后您可以在您的代码中使用它。

希望这可以帮助

如果你不明白我的意思，我会尽可能详细地解释一下。