我一直在不知疲倦地尋找解決方案，并且已經接近我正在尋找的解決方案。我在某種程度上是 VBA 編碼的初學者，并且一直在通過嘗試尋找某些功能的代碼來學習。
我有這個時間表，并且基于行中的一天（F8：AJ8），如果它=“Fri”，我希望它的整個列用黃色突出顯示（顏色索引= 44）并更改它們的值（每行上的備用單元格）從10 到 0，但僅限于名為“Timesheetarea”（F8：AJ131）的范圍，因為有時我必須添加行。
下面的代碼面臨的問題是當按下命令按鈕時，如果 F8 是星期五，那么所有 10 都被替換為“”，并且顏色被填充到單元格 F151（位于簽名部分并且超出表格邊框）如果 F8 是“Sat”，則所有“”變為 10，如果再次按下，則變為 110、1110 等。
我正在嘗試一列的代碼，如果它有效，我將為從 F 到 AJ 的其余列修改它。
另請注意，不包含 31 天的月份，那一天 (31) 自動為“”，其列值將是“”，因此它們不會被添加。這是通過 F8 - AJ8 確定日期的公式 =IF(AJ7="","",TEXT(AJ7,"ddd"))
這是從單元格 G7 到 AJ7 獲取月份日期的公式 =IF(F7="","",IF(MONTH(F7)<>MONTH(F7 1),"",F7 1))
F7 的公式是 =IF(F1="","",DATEVALUE("1"&F1))
這樣，例如，如果 2 月是 28 天，則 28-2-21 之后的下 3 個單元格將為空白，并且它們的天數將顯示為空白。
Sub fixFri()
Application.ScreenUpdating = False
Dim bottoma As Integer
Dim bottomB As Integer
Dim bottomC As Integer
Dim bottomD As Integer
Dim bottomE As Integer
Dim bottomf As Integer
Dim bottomg As Integer
Dim bottomh As Integer
Dim bottomi As Integer
Dim bottomj As Integer
Dim bottomk As Integer
Dim bottoml As Integer
Dim bottomm As Integer
Dim bottomn As Integer
Dim bottomo As Integer
Dim bottomp As Integer
Dim bottomq As Integer
Dim bottomr As Integer
Dim bottoms As Integer
Dim bottomt As Integer
Dim bottomu As Integer
Dim bottomv As Integer
Dim bottomw As Integer
Dim bottomx As Integer
Dim bottomy As Integer
Dim bottomz As Integer
Dim bottomaa As Integer
Dim bottomab As Integer
Dim bottomac As Integer
Dim bottomad As Integer
Dim bottomae As Integer
bottoma = Range("F" & Rows.Count).End(xlUp).Row
bottomB = Range("G" & Rows.Count).End(xlUp).Row
bottomC = Range("H" & Rows.Count).End(xlUp).Row
bottomD = Range("I" & Rows.Count).End(xlUp).Row
bottomE = Range("J" & Rows.Count).End(xlUp).Row
bottomf = Range("K" & Rows.Count).End(xlUp).Row
bottomg = Range("L" & Rows.Count).End(xlUp).Row
bottomh = Range("M" & Rows.Count).End(xlUp).Row
bottomi = Range("N" & Rows.Count).End(xlUp).Row
bottomj = Range("O" & Rows.Count).End(xlUp).Row
bottomk = Range("P" & Rows.Count).End(xlUp).Row
bottoml = Range("q" & Rows.Count).End(xlUp).Row
bottomm = Range("r" & Rows.Count).End(xlUp).Row
bottomn = Range("s" & Rows.Count).End(xlUp).Row
bottomo = Range("t" & Rows.Count).End(xlUp).Row
bottomp = Range("u" & Rows.Count).End(xlUp).Row
bottomq = Range("v" & Rows.Count).End(xlUp).Row
bottomr = Range("w" & Rows.Count).End(xlUp).Row
bottoms = Range("x" & Rows.Count).End(xlUp).Row
bottomt = Range("y" & Rows.Count).End(xlUp).Row
bottomu = Range("Z" & Rows.Count).End(xlUp).Row
bottomv = Range("aa" & Rows.Count).End(xlUp).Row
bottomw = Range("ab" & Rows.Count).End(xlUp).Row
bottomx = Range("ac" & Rows.Count).End(xlUp).Row
bottomy = Range("ad" & Rows.Count).End(xlUp).Row
bottomz = Range("ae" & Rows.Count).End(xlUp).Row
bottomaa = Range("af" & Rows.Count).End(xlUp).Row
bottomab = Range("ag" & Rows.Count).End(xlUp).Row
bottomac = Range("ah" & Rows.Count).End(xlUp).Row
bottomad = Range("ai" & Rows.Count).End(xlUp).Row
bottomae = Range("aj" & Rows.Count).End(xlUp).Row
Dim rng1 As Range
Dim rng2 As Range
Dim rng3 As Range
Dim rng4 As Range
Dim rng5 As Range
Dim rng6 As Range
Dim rng7 As Range
Dim rng8 As Range
Dim rng9 As Range
Dim rng10 As Range
Dim rng11 As Range
Dim rng12 As Range
Dim rng13 As Range
Dim rng14 As Range
Dim rng15 As Range
Dim rng16 As Range
Dim rng17 As Range
Dim rng18 As Range
Dim rng19 As Range
Dim rng20 As Range
Dim rng21 As Range
Dim rng22 As Range
Dim rng23 As Range
Dim rng24 As Range
Dim rng25 As Range
Dim rng26 As Range
Dim rng27 As Range
Dim rng28 As Range
Dim rng29 As Range
Dim rng30 As Range
Dim rng31 As Range
Dim Lday1 As String
Dim Lday2 As String
Dim Lday3 As String
Dim Lday4 As String
Dim Lday5 As String
Dim Lday6 As String
Dim Lday7 As String
Dim Lday8 As String
Dim Lday9 As String
Dim Lday10 As String
Dim Lday11 As String
Dim Lday12 As String
Dim Lday13 As String
Dim Lday14 As String
Dim Lday15 As String
Dim Lday16 As String
Dim Lday17 As String
Dim Lday18 As String
Dim Lday19 As String
Dim Lday20 As String
Dim Lday21 As String
Dim Lday22 As String
Dim Lday23 As String
Dim Lday24 As String
Dim Lday25 As String
Dim Lday26 As String
Dim Lday27 As String
Dim Lday28 As String
Dim Lday29 As String
Dim Lday30 As String
Dim Lday31 As String
Dim Ldayvalue As Integer
Lday1 = Range("F8").Value
For Each rng1 In Range("F8:F" & bottoma)
If Lday1 = "Fri" Then
rng1.Value = Replace(rng1, 10#, 0#)
rng1.Interior.ColorIndex = 44
ElseIf Lday1 = "Sat" Then
rng1.Value = Replace(rng1, 0#, 10#)
rng1.Interior.ColorIndex = 2
ElseIf Lday1 = "Sun" Then
rng1.Value = Replace(rng1, 0#, 10#)
rng1.Interior.ColorIndex = 2
ElseIf Lday1 = "Mon" Then
rng1.Value = Replace(rng1, 0#, 10#)
rng1.Interior.ColorIndex = 2
ElseIf Lday1 = "Tue" Then
rng1.Value = Replace(rng1, 0#, 10#)
rng1.Interior.ColorIndex = 2
ElseIf Lday1 = "Wed" Then
rng1.Value = Replace(rng1, 0#, 10#)
rng1.Interior.ColorIndex = 2
ElseIf Lday1 = "Thu" Then
rng1.Value = Replace(rng1, 0#, 10#)
rng1.Interior.ColorIndex = 2
ElseIf Lday1 = "" Then
rng1.Value = Replace(rng1, 10#, 0#)
rng1.Value = Replace(rng1, 0#, 0#)
rng1.Interior.ColorIndex = 2
End If
Next rng1
End Sub
uj5u.com熱心網友回復：
無需向下掃描作業表，您可以使用Range.Replace
Sub fixFri()
Const TIMESHEET = "F8:AJ131"
Dim wb As Workbook, ws As Worksheet
Dim LastRow As Long, c As Range, d As String
Set wb = ThisWorkbook
Set ws = wb.ActiveSheet
' scan across timesheet columns
For Each c In ws.Range(TIMESHEET).Columns
d = c.Cells(1) ' day
If d = "" Then
' skip
ElseIf d = "Fri" Then
c.Interior.Color = RGB(255, 255, 0) ' yellow
c.Replace 10, 0, lookat:=xlWhole
Else
c.Interior.Pattern = xlNone 'no color
c.Replace 0, 10, lookat:=xlWhole
End If
Next
MsgBox "Done", vbInformation
End Sub
轉載請註明出處，本文鏈接：https://www.uj5u.com/gongcheng/419977.html
標籤：
上一篇：獲取excel顯示值