八达网

标题: 万能的8DA啊 [打印本页]

作者: 太阳快跑 时间: 2010-7-30 14:29
标题: 万能的8DA啊
谁懂VB代码

Sub Macro1()
'
' Macro1 Macro
' 123 记录的宏 2009-12-8
'

Dim colorvalue(100) As Integer
Dim colorcount(100) As Integer

Dim colorindex As Integer

Dim irow As Long
Dim icol As Long
Dim tmpcolor As Integer
Dim tmpret As Integer
Dim i As Long

colorindex = 0
MAXCOLBLANK = 0
MAXROWBLANK = 0

For irow = 1 To 65536 Step 1

MAXCOLBLANK = 0
For icol = 1 To 65536 Step 1
      If Cells(irow, icol) = "" Then
         MAXCOLBLANK = MAXCOLBLANK + 1
         If MAXCOLBLANK > 10 Then
            MAXROWBLANK = MAXROWBLANK + 1
            Exit For
         End If
      Else
         If Cells(irow, icol) = "颜色计算列表:" Then Exit For
         MAXCOLBLANK = 0
         MAXROWBLANK = 0

         tmpcolor = Cells(irow, icol).Interior.colorindex
         tmpret = GetColorIndex(tmpcolor, colorvalue, colorindex)
         If tmpret = -1 Then
            colorindex = colorindex + 1
            colorvalue(colorindex) = tmpcolor
            colorcount(colorindex) = 1
         Else
            colorcount(tmpret) = colorcount(tmpret) + 1
         End If
      End If

Next
If MAXROWBLANK > 10 Then
      Exit For
End If

If Cells(irow, icol) = "颜色计算列表:" Then Exit For

Next

Cells(irow, 1) = "颜色计算列表:"
For i = irow + 1 To irow + 100 Step 1
      Cells(i, 1).Interior.colorindex = xlNone
      Cells(i, 2) = ""
Next

For i = 1 To colorindex
      Cells(irow + i, 1).Interior.colorindex = colorvalue(i)
      Cells(irow + i, 2) = colorcount(i)
Next

End Sub

Function GetColorIndex(tmpcolor As Integer, colorvalue() As Integer, colorindex As Integer)
Dim i As Integer

GetColorIndex = -1
For i = 1 To colorindex Step 1
      If tmpcolor = colorvalue(i) Then
         GetColorIndex = i
         Exit For
      End If
Next


End Function

这段代码现在出现个问题谁能帮帮ME。。。

欢迎光临八达网 (https://www.8-da.com/)