|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
我一般不建议用合并单元格。
- Sub TZ20180613()
- Dim t
- Dim arr
- Dim m, n
- Dim Sk$
- Dim s_Return$
- Dim tmp
- Dim k%
- t = Timer
- arr = Sheet1.UsedRange
- With Sheet2
- For m = 3 To .Cells(65536, 1).End(xlUp).Row 'Loop Row
- For n = 2 To .Cells(1, 256).End(xlToLeft).Column 'Loop Column
- Sk = .Cells(m, 1) & "/" & .Cells(1, n) '<-WC/Date
- s_Return = Get_Str_from_Array(arr, Sk)
- If Len(s_Return) > 1 Then
- tmp = Split(s_Return, "|")
- .Cells(m, n) = tmp(0)
- For k = 0 To Int(tmp(1))
- .Cells(m, n + k).Interior.ColorIndex = 3 '<-RED
- Next k
- Exit For
- Else
- .Cells(m, n) = ""
- .Cells(m, n).Interior.ColorIndex = 0
- End If
- Next n
- Next m
- End With
- MsgBox (Timer - t)
- End Sub
- Function Get_Str_from_Array(arr, Str$) As String
- Dim i
- Dim Sk$
- Dim i_Dur
- For i = 2 To UBound(arr)
- Sk = arr(i, 2) & "/" & arr(i, 5) '<-WC/Date
- If Sk = Str Then
- i_Dur = arr(i, 6) - arr(i, 5)
- Get_Str_from_Array = arr(i, 9) & "|" & i_Dur
- Exit Function
- End If
- Next i
- Get_Str_from_Array = ""
- End Function
复制代码
|
评分
-
1
查看全部评分
-
|