[發問] 指定號碼在偶數欄的總個數及奇數欄的總次數

帖子: 678
主題: 147
精華: 0
積分: 799
點名: 0
作業系統: win 8
軟體版本: MS 2003
閱讀權限: 50
性別: 男
註冊時間: 2016-2-9
最後登錄: 2022-1-20

22^#

發表於 2021-8-23 08:03 | 只看該作者

回復 21# samwang
我不是意在比較寫法~您可能誤會我的意思了

If..... Then......End If 只能用在單純的需求，
貴語法的適用範圍寬廣許多~所以才一再冒昧大擾您~尚請見諒

非常謝謝您耐心的指導和熱心幫忙~感恩

samwang

大學生 Rank: 4

帖子: 976
主題: 7
精華: 0
積分: 1018
點名: 0
作業系統: Win10
軟體版本: Office 2016
閱讀權限: 50
性別: 男
註冊時間: 2013-4-19
最後登錄: 2024-10-30

21^#

發表於 2021-8-23 07:45 | 只看該作者

回復 20# ziv976688

後學也是學習中，每個人寫法不一定都一樣，只要能寫出需求功能就好，感謝。

帖子: 678
主題: 147
精華: 0
積分: 799
點名: 0
作業系統: win 8
軟體版本: MS 2003
閱讀權限: 50
性別: 男
註冊時間: 2016-2-9
最後登錄: 2022-1-20

20^#

發表於 2021-8-23 07:37 | 只看該作者

本帖最後由 ziv976688 於 2021-8-23 07:41 編輯

回復 19# samwang

不太能理解您的意思，
尋找 = .[A4:A9] 且字體顏色=7號的數字，取代為4號底色 >> 這是不是和#16程式需求一樣嗎?

是的! 謝謝您

-----------------
不好意思~
我只會最基本的 If..... Then......End If  的語法
EX :這個需求，我只會~
Sub test()
Dim i%, j%, k%

With Sheets("Sheet1")
For i = 4 To 9
  For j = 2 To 50
For k = 2 To 110
If Cells(j, k).Font.ColorIndex = 7 Then
   If (Cells(j, k) = Cells(i, 1)) Then
   Cells(j, k).Interior.ColorIndex = 4
   End If
   If (Cells(j, k) = Cells(10, 1)) Then
   Cells(j, k).Interior.ColorIndex = 8
   End If
End If
Next k
Next j
  Next i
End With
End Sub

因為很想學習貴語法，所以才冒昧一題勞煩您這麼多次~尚請見諒

謝謝您

samwang

大學生 Rank: 4

帖子: 976
主題: 7
精華: 0
積分: 1018
點名: 0
作業系統: Win10
軟體版本: Office 2016
閱讀權限: 50
性別: 男
註冊時間: 2013-4-19
最後登錄: 2024-10-30

19^#

發表於 2021-8-23 07:26 | 只看該作者

回復 samwang
S大大 : 您好 !
不好意思，能否請您另外再指導~以尋找→取代的方式來完成需求?
EX1：範圍 ...
ziv976688 發表於 2021-8-23 00:15

不太能理解您的意思，
尋找 = .[A4:A9] 且字體顏色=7號的數字，取代為4號底色 >> 這是不是和#16程式需求一樣嗎?

帖子: 678
主題: 147
精華: 0
積分: 799
點名: 0
作業系統: win 8
軟體版本: MS 2003
閱讀權限: 50
性別: 男
註冊時間: 2016-2-9
最後登錄: 2022-1-20

18^#

發表於 2021-8-23 00:15 | 只看該作者

本帖最後由 ziv976688 於 2021-8-23 00:44 編輯

回復 16# samwang
S大大 : 您好 !
不好意思，能否請您另外再指導~以尋找→取代的方式來完成需求?
EX1：範圍 = .Columns("B:DF")，尋找 = .[A4:A9] 且字體顏色=7號的數字，取代為4號底色。
EX2：範圍 = .Columns("B:DF")，尋找 = .[A10] 且字體顏色=7號的數字，取代為8號底色。
恕小弟笨拙~當標示的範圍改變時，原程式碼的各關鍵數字~我無法調整到完全符合(總有衝突)需求的數字。
謝謝您！

======================================
如下列錄製以尋找和取代的方式之程式碼 :
With Sheets("Sheet1")
.Columns("B:DF").Select
With Application.FindFormat.Font
      .FontStyle = "粗體"
      .Subscript = False
      .ColorIndex = 7
End With
Application.ReplaceFormat.Interior.ColorIndex = 8
Selection.Replace What:=.[A10], Replacement:="", LookAt:=xlWhole, _
      SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=True, _
      ReplaceFormat:=True
End With

帖子: 678
主題: 147
精華: 0
積分: 799
點名: 0
作業系統: win 8
軟體版本: MS 2003
閱讀權限: 50
性別: 男
註冊時間: 2016-2-9
最後登錄: 2022-1-20

17^#

發表於 2021-8-22 22:12 | 只看該作者

回復 16# samwang
完全OK了!
感謝您

samwang

大學生 Rank: 4

帖子: 976
主題: 7
精華: 0
積分: 1018
點名: 0
作業系統: Win10
軟體版本: Office 2016
閱讀權限: 50
性別: 男
註冊時間: 2013-4-19
最後登錄: 2024-10-30

16^#

發表於 2021-8-22 15:41 | 只看該作者

回復 15# ziv976688

儲存格反顏色如下，請測試看看，謝謝

Sub test()
Dim Arr, Brr
With Sheets("Sheet1")
Arr = .[a1:a10]
R = .Columns("M:V").Find("*", , , , , 2).Row
Brr = .Range("M1:DF" & R)
For i = 4 To UBound(Arr)
      If i < UBound(Arr) Then
         .Cells(i, 1).Interior.Color = 65280
         For j = 1 To UBound(Brr, 2) Step 2
         For i2 = 2 To UBound(Brr)
            If Brr(i2, j) = Arr(i, 1) Then
            .Cells(i2, j + 12).Interior.Color = 65280
            End If
         Next i2
         Next j
      Else
         .Cells(i, 1).Interior.Color = 16776960
         For j = 1 To UBound(Brr, 2) Step 2
         For i2 = 2 To UBound(Brr)
            If Brr(i2, j) = Arr(i, 1) Then
            .Cells(i2, j + 12).Interior.Color = 16776960
            End If
         Next i2
         Next j
      End If
Next
End With
End Sub