Private Sub Command4_Click()
Dim ADO1, ADO2, ADO3, ADO4, ADO5, ADO6 As Integer
For io = 1 To 100 '?趨?????
If InStr(Cells(1, io), "O???1") Then
ADO1 = Cells(1, io).Column
End If
If InStr(Cells(1, io), "O???2") Then
ADO2 = Cells(1, io).Column
End If
If InStr(Cells(1, io), "O???3") Then
ADO3 = Cells(1, io).Column
End If
If InStr(Cells(1, io), "O???4") Then
ADO4 = Cells(1, io).Column
End If
If InStr(Cells(1, io), "O???5") Then
ADO5 = Cells(1, io).Column
End If
If InStr(Cells(1, io), "O???6") Then
ADO6 = Cells(1, io).Column
End If
Next io'MsgBox ADI1 & ADI2 & ADI3 & ADI4 & ADI5 & ADI6
'??????
Dim ColumnIDo()ColumnIDo = Array("qq", "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", "AA", "AB", "AC", "AD", "AE", "AF", "AG", "AH", "AI", "AJ", "AK", "AL", "AM", "AN", "AO", "AP", "AQ", "AR", "AS", "AT", "AU", "AV", "AW", "AX", "AY", "AZ", "BA", "BB", "BC", "BD", "BE", "BF", "BG", "BH", "BI", "BJ", "BK", "BL", "BM", "BN", "BO", "BP", "BQ", "BR", "BS", "BT", "BU", "BV", "BW", "BX", "BY", "BZ")Dim CellPosRowo(1 To 2000), CellPosColumno(1 To 2000) As Integer
Dim CellPoso(1 To 2000) As StringDim rngADO1, rngADO2, rngADO3, rngADO4, rngADO5, rngADO6 As Range, rng1o, rang2o, rng3o, rng4o, rng5o, rng6o As RangeDim yo As Integer
Dim iiio As Long
iiio = 1 Set rngADO1 = Range(Range(ColumnIDo(ADO1) & 2), Range(ColumnIDo(ADO6) & 2000)) For Each rng1o In rngADO1 yo = rng1o.Interior.ColorIndex ''''?????bai????????du If yo = 6 Then
CellPoso(iiio) = rng1o.Address
CellPosRowo(iiio) = rng1o.Row
CellPosColumno(iiio) = rng1o.Column
iiio = iiio + 1
End If
Next
Dim jo, ko, mo As Integer
jo = 1
ko = 0
mo = 1
For jo = 1 To UBound(CellPoso)
Range(CellPoso(jo)) = "CH" & ko
If mo < 10 Then
Range(CellPoso(jo)).Offset(0, -1) = "ADO0" & mo
Else
Range(CellPoso(jo)).Offset(0, -1) = "ADO" & mo
End If
ko = ko + 1
If ko > 15 Then
ko = 0
mo = mo + 1
End If
NextEnd SubPrivate Sub Command5_Click()
Dim IP1 As Integer
For i = 1 To 100 '?趨?????
If InStr(Cells(1, i), "DT_X1") Then
IP1 = Cells(1, i).Column
End IfNext i'MsgBox ADI1 & ADI2 & ADI3 & ADI4 & ADI5 & ADI6
'??????
Dim ColumnID()ColumnID = Array("qq", "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", "AA", "AB", "AC", "AD", "AE", "AF", "AG", "AH", "AI", "AJ", "AK", "AL", "AM", "AN", "AO", "AP", "AQ", "AR", "AS", "AT", "AU", "AV", "AW", "AX", "AY", "AZ", "BA", "BB", "BC", "BD", "BE", "BF", "BG", "BH", "BI", "BJ", "BK", "BL", "BM", "BN", "BO", "BP", "BQ", "BR", "BS", "BT", "BU", "BV", "BW", "BX", "BY", "BZ")
Dim CellPosRow(1 To 2000), CellPosColumn(1 To 2000) As Integer
Dim CellPos(1 To 2000) As StringDim rngIP1 As Range, rng1 As RangeDim y As Integer
Dim iii As Long
iii = 1 Set rngIP1 = Range(Range(ColumnID(IP1) & 2), Range(ColumnID(IP1) & 2000)) For Each rng1 In rngIP1 y = rng1.Interior.ColorIndex ''''?????bai????????du If y = 35 Then
CellPos(iii) = rng1.Address
CellPosRow(iii) = rng1.Row
CellPosColumn(iii) = rng1.Column
iii = iii + 1
End If
Next
Dim j, k, m As Integer
j = 1
k = 1
For j = 1 To UBound(CellPos)
Range(CellPos(j)) = "X" & k
k = k + 1 Next
End Sub
程序能正常执行，但是执行完就报“range方法作用于global失败”

有没有大佬帮忙指导一下嘞

或许这段代码原本的样子能正常运行，但是你复制上来的东西里面明显有乱码，而且很多换行符都丢失了，别人没法用啊

好吧，我回复你的时候2楼还没审核通过，没看到……
看这个图，应该是CellPoso这个数组里面元素的值的问题，一共2000个元素，应该没有全部赋值吧，但是代码写的是遍历全部元素（对于静态数组，它的UBound也是固定的，表示全部元素的上界，而不是用到的元素的上界）
你要是想用UBound，应该改成动态数组；否则，就需要用一个计数变量，比如前面的iiio，它的值减1就是这里应该循环到的数