问题描述
寻求以下方面的帮助:
目标:
- 一一比较 2 个定义范围(相同大小)中的单元格。如果它们相同,则移至下一组单元格。如果不是:
- 在第三个范围内的相应单元格中输入一个整数(1 到 2000 之间)(与其他 2 个范围相同)。在 For 循环中运行此操作,直到前 2 个范围中的单元格彼此相等。
- 完成后,继续下一组单元格,依此类推。
到目前为止我编写的代码概述如下,但它没有产生正确的结果。据我所知,hCell 值循环,而其余的则不循环,这将关闭 If 比较条件...
感谢您对此的任何帮助!
Sub Update()
Range("A1").Select
ActiveWindow.ScrollColumn = 1
ActiveWindow.ScrollRow = 1
Sheets("Funds").Select
Range("A1").Select
ActiveWindow.ScrollColumn = 1
ActiveWindow.ScrollRow = 1
'resets the "looping cells" from NR8 to PF207.
'Dim d As Integer
For d = 8 To 207
Range(Cells(d,382),Cells(d,422)) = ""
Next
Dim e As Integer
e = 1
Dim fRng As Range: Set fRng = Range("RB8:SP207")
Dim fCell As Range
Dim gRng As Range: Set gRng = Range("SU8:UI207")
Dim gCell As Range
Dim hRng As Range: Set hRng = Range("NR8:PF207")
Dim hCell As Range
Dim i As Integer
i = i
For e = 8 To 207
For Each fCell In fRng.Cells
For Each gCell In gRng.Cells
For Each hCell In hRng.Cells
If Cells(e,191).Value = 0 Then
Exit For
Else
If (fCell.Value >= gCell.Value Or gCell.Value = "N/A") Then
Exit For
Else
For i = 0 To 2000
If fCell.Value >= gCell.Value Then
Exit For
Else
hCell.Value = i
If fCell.Value >= gCell.Value Then
Exit For
End If
End If
Next i
End If
End If
Next hCell,gCell,fCell
End If
Next e
Range("A1").Select
End Sub
解决方法
我假设前两个范围中的值在某种程度上取决于第三个范围中的值。
Option Explicit
Sub Update()
Const NCOLS = 41 ' 41
Const NROWS = 200 ' 200
Const LOOPMAX = 2000 ' 2000
Dim wb As Workbook,ws As Worksheet
Dim rng1 As Range,rng2 As Range,rng3 As Range
Dim cell1 As Range,cell2 As Range
Dim i As Long,r As Long,c As Integer,t0 As Double
t0 = Timer
Set wb = ThisWorkbook
Set ws = wb.Sheets(1)
Set rng1 = ws.Range("RB8")
Set rng2 = ws.Range("SU8")
Set rng3 = ws.Range("NR8")
'resets NR8 to PF207.
rng3.Resize(NROWS,NCOLS).Value = ""
Application.ScreenUpdating = False
For r = 1 To NROWS
Application.StatusBar = "Row " & r & " of " & NROWS
For c = 1 To NCOLS
Set cell1 = rng1.Offset(r - 1,c - 1)
Set cell2 = rng2.Offset(r - 1,c - 1)
If (cell1.Value <> cell2.Value) Or (cell2.Value = "N/A") Then
i = 0
Do
rng3.Offset(r - 1,c - 1) = i
i = i + 1
Loop Until cell1.Value = cell2.Value Or i > LOOPMAX
End If
Next c
Next r
Application.ScreenUpdating = True
MsgBox "Done",vbInformation,Int(Timer - t0) & " seconds"
rng3.Select
End Sub