mpjx.net
当前位置:首页 >> EXCEL VBA按颜色提取内容和颜色 >>

EXCEL VBA按颜色提取内容和颜色

程序如下: Sub 宏()Dim i As Integer, j As Integer, k As IntegerFor i = 4 To 41 k = Cells(Rows.Count, i).End(xlUp...

Public C '定义全局变量CPrivate Sub Worksheet_SelectionChange(ByVal Target As Range)On Error Resume Next Dim one...

Sub s() Set rg1 = [K14:T23] Set rg2 = [V3:w13] Set t = [m1:q1] x = 1 y = 1 For i = 1 To 5 cl = t(i).Interior.Color kk = "" For j = 1 To rg1.Columns.Count For k = 1 To rg1.Rows.Count If rg1.Cells(k, j).Interior.Color = cl Then I...

举例说明。 例如有表格如图: 要求将黄色的内容放到另一表格中。 第一步:在当前工作表中编制代码如下: Dim myRang As StringDim mySheeti = Range("B65536").End(xlUp).Row '记录最后行号myRang = "a1:b" & Trim(Str(i))myArr1 = Range(myRang...

r = ColorInfo Mod 256 g = (ColorInfo - r) / 256 Mod 256 b = (ColorInfo - r - g * 256) / 256 ^ 2 Color=RGB(R, G, B) 用位运算分离RGB: R = Color And &HFF G = (Color And &HFF00&) \ &H100 B = (Color And &HFF0000) \ &H10000 是不是...

Sub s() k = 2 Do While Cells(k, 1) "" For i = 1 To 4 t = Mid(Cells(k, 1), i, 1) j = 1 Do While Mid(Cells(k, i + 1), j, 1) t j = j + 1 If j > Len(Cells(k, i + 1)) Then Exit Do Loop If j 0 Then Cells(k, i + 1).Characters(j, 1).Fo...

Sub s() t = [M1] c = Array(0, 3, 14, 6, 33) Dim k(9 To 12) For i = 1 To 4 k(i + 8) = Mid(t, i, 1) Next Set d = CreateObject("scripting.dictionary") For i = 4 To 66 For j = 9 To 12 If Cells(i, j) = "" Then GoTo 1 d(InStr(Cells(i...

Sub jizhang()Dim WS1 As WorksheetDim Rnum1, Rnum2Set WS1 = Worksheets("sheet2")arr = Array(Range("F1"), Range("B1"), Range("B2"), Range("B3"))Rnum2 = WS1.Range("B65536").End(xlUp).Row + 1Rnum1 = 5Do Until Cells(Rnum1, 2) = ""br...

Sub xx() Dim x(1 To 3) a = Range([K3]).Column b = Range([K3]).Column + Range([K3]).Columns.Count - 1 s = [L3] c = 1 Do While c < 4 ^ 8 For i = a To b If Cells(c, i).Interior.ColorIndex xlNone Then c = c - 1 Exit Do End If Next ...

一键按钮已制作完成 使用方法: 只需把你的数据复制到我附件中的Sheet1,然后点击“一键填充颜色”即可。 按钮源代码如下: Sub 填充颜色()'' 填充颜色 by zzllrr'' Dim k, r0, r1 k = 0 r0 = 3 For i = 3 To ActiveSheet.Columns(6).Find("*", , ...

网站首页 | 网站地图
All rights reserved Powered by www.mpjx.net
copyright ©right 2010-2021。
内容来自网络,如有侵犯请联系客服。zhit325@qq.com