- 帖子
- 254
- 主題
- 6
- 精華
- 0
- 積分
- 310
- 點名
- 0
- 作業系統
- W10
- 軟體版本
- Excel 2016
- 閱讀權限
- 20
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2019-6-16
- 最後登錄
- 2024-9-23
|
22#
發表於 2020-10-12 05:30
| 只看該作者
回復 18# wei9133
剛才發現跑太久了 所以改了一下 有比較好一點 但是還是很慢- Public Sub 多列比對練習()
- Application.ScreenUpdating = False
- Dim Arr, i&, j&, t&, tj&, x&, y&, T1$, T2$, T3$, T4$
- Arr = Range(Cells(Rows.Count, 1).End(xlUp), Cells(2, 100))
- For t = 1 To UBound(Arr, 1)
- TI = "": T2 = ""
- For tj = 1 To UBound(Arr, 2)
- If Arr(t, tj) = "" Then
- Arr(t, tj) = "-"
- Arr(t, tj) = Arr(t, tj) & Arr(t, tj)
- End If
- T1 = Arr(t, tj)
- T2 = T2 & T1
- If tj = UBound(Arr, 2) Then T2 = T2 & Cells(t + 1, 104)
- Next tj
- For i = UBound(Arr, 1) To t + 1 Step -1
- T3 = "": T4 = ""
- For j = 1 To UBound(Arr, 2)
- If Arr(i, j) = "" Then
- Arr(i, j) = "-"
- Arr(i, j) = Arr(i, j) & Arr(i, j)
- End If
- T3 = Arr(i, j)
- T4 = T4 & T3
- If j = UBound(Arr, 2) Then T4 = T4 & Cells(i + 1, 104)
- Next j
- If T4 = T2 Then
- Cells(t + 1, 101) = Cells(t + 1, 101) + Cells(t + 1, 101)
- Cells(i + 1, 101) = Cells(i + 1, 101) + Cells(i + 1, 101)
- Cells(t + 1, 103) = Cells(t + 1, 103) - Cells(t + 1, 103)
- Cells(i + 1, 103) = Cells(i + 1, 103) - Cells(i + 1, 103)
- Cells(t + 1, 104).Interior.Color = RGB(255, 255, 0)
- Cells(i + 1, 104).Interior.Color = RGB(255, 255, 0)
- End If
- Next i
- Next t
- For x = 2 To Cells(2, 1).End(xlDown).Row
- For y = Cells(2, 1).End(xlDown).Row To x + 1 Step -1
- If Cells(x, 104).Interior.Color = RGB(255, 255, 0) _
- And Cells(y, 104).Interior.Color = RGB(255, 255, 0) Then
- If Cells(x, 104) = Cells(y, 104) Then
- Rows(y).Delete
- End If
- End If
- Next y
- Next x
- Application.ScreenUpdating = True
- End Sub
複製代碼 |
|