问题描述
下面的代码可以完美地运行和执行，我只想添加一些功能。该代码将新行从报告文件导入到工作簿文件，我希望它通过行中的每个单元格而不是仅通过G列（包含数字或用逗号分隔的数字）来检查包含新数据的潜在行。范围A2：BQ。即使该行在工作簿中存在，也要通过G列中的数字来更新新找到的单元格。还要在工作簿文件中以亮色突出显示新行。最后一件事是在新单元格的导入完成后包装文本。
if rec.discount:
解决方法
由于您似乎无法比较两个范围：
'Do two ranges contain the same value(s)?
' does not handle error values...
Function RangesMatch(rng1 As Range,rng2 As Range) As Boolean
Dim rv As Boolean,v1,v2,r As Long,c As Long
If rng1.Rows.Count = rng2.Rows.Count And _
rng1.Columns.Count = rng2.Columns.Count Then
v1 = rng1.Value
v2 = rng2.Value
If rng1.Count = 1 Then
RangesMatch = (v1 = v2) 'single cell ranges...
Else
'multi-cell ranges: loop and compare values
For r = 1 To UBound(v1,1)
For c = 1 To UBound(v1,2)
If v1(r,c) <> v2(r,c) Then
Exit Function 'by default returns false
End If
Next c
Next r
RangesMatch = True
End If
End If
End Function
这是我走了多远：
Sub Weekly_Report()
Const HAS_HEADER As Boolean = True 'Set true if the file has a header(Report)
Const NUM_COLS As Long = 69 '69 cells in the row needed to be imported from the Report
Const FILENAME = "Report.xlsx"
Const PATH = "C:\Users\Documents\" 'path of the report
Dim wbReport As Workbook,wsReport As Worksheet,wsData As Worksheet
Dim next_blank_row As Long,iStartRow As Long,iLastRow As Long,iRow As Long
Dim sFilename As String
Set wsData = ThisWorkbook.Worksheets("Sheet1") 'for example: destination worksheet
next_blank_row = wsData.Cells(Rows.Count,"G").End(xlUp).Row + 1 'next blank row
sFilename = PATH & FILENAME
Debug.Print "Opening ",sFilename 'Openning file
On Error Resume Next
Set wbReport = Workbooks.Open(sFilename)
On Error GoTo 0
If wbReport Is Nothing Then
MsgBox "Can not open " & sFilename,vbCritical,"ERROR" 'If the file was not found or cannot be opened
Exit Sub
End If
Set wsReport = wbReport.Worksheets(1) 'Expects only one sheet in the Report
iStartRow = IIf(HAS_HEADER,2,1) 'If it has header start from row 2
iLastRow = wsReport.Cells(Rows.Count,1).End(xlUp).Row
Dim s As String,rng As Range,m As Long,m2 As String,m3 As String,s2 As String,s3 As String,rng2 As Range,rng3 As Range
For iRow = iStartRow To iLastRow
s = CStr(wsReport.Cells(iRow,"G").Value)
Set rng = wsData.Columns("G").Find(s)
s2 = CStr(wsReport.Cells(iRow,"P").Value)
Set rng2 = wsData.Columns("P").Find(s2)
s3 = CStr(wsReport.Cells(iRow,"S").Value)
Set rng3 = wsData.Columns("S").Find(s3)
If rng Is Nothing Then
m = next_blank_row 'no match - use next blank row and increment
next_blank_row = next_blank_row + 1
Debug.Print iRow,s,"New row " & m
Else
m = rng.Row
Debug.Print iRow,"Match row " & m 'Match row:if the line already exists in the file
m2 = rng2.Row
m3 = rng3.Row
End If
wsData.Cells(m,1).Resize(1,NUM_COLS).Value = wsReport.Cells(iRow,NUM_COLS).Value
wsData.Cells(m2,NUM_COLS).Value
wsData.Cells(m3,NUM_COLS).Value
Next
MsgBox wsReport.Name & " scanned from row " & iStartRow & _
" to " & iLastRow,vbInformation,sFilename
wbReport.Close False 'Close the Report
End Sub
这将更新与列G匹配的行的P和S列；如果不匹配，则添加行。
Option Explicit
Sub Weekly_Report()
Const HAS_HEADER As Boolean = True 'Set true if the file has a header(Report)
Const NUM_COLS As Long = 69 '69 cells in the row needed to be imported from the Report
Const FILENAME = "Report.xlsx"
Const PATH = "C:\Users\Documents\" 'path of the report
Dim wbReport As Workbook,wsData As Worksheet
Dim next_blank_row As Long,iRow As Long
Dim sFilename As String
Set wsData = ThisWorkbook.Worksheets("Sheet1") 'for example: destination worksheet
next_blank_row = wsData.Cells(Rows.Count,"G").End(xlUp).Row + 1 'next blank row
sFilename = PATH & FILENAME
Debug.Print "Opening ",sFilename 'Openning file
On Error Resume Next
Set wbReport = Workbooks.Open(sFilename)
On Error GoTo 0
If wbReport Is Nothing Then
MsgBox "Can not open " & sFilename,"ERROR" 'If the file was not found or cannot be opened
Exit Sub
End If
Set wsReport = wbReport.Worksheets(1) 'Expects only one sheet in the Report
iStartRow = IIf(HAS_HEADER,1) 'If it has header start from row 2
iLastRow = wsReport.Cells(Rows.Count,1).End(xlUp).Row
Dim rng As Range,rng3 As Range
Dim m As Long,s As String,c As Variant
Dim iAdd As Long,iUpdate As Long
For iRow = iStartRow To iLastRow
s = CStr(wsReport.Cells(iRow,"G").Value)
Set rng = wsData.Columns("G").Find(s)
If rng Is Nothing Then
m = next_blank_row 'no match - use next blank row and increment
next_blank_row = next_blank_row + 1
With wsData.Cells(m,NUM_COLS)
.Value = wsReport.Cells(iRow,NUM_COLS).Value
.Interior.Color = vbYellow
End With
iAdd = iAdd + 1
Debug.Print iRow,"New row " & m
Else
m = rng.Row
For Each c In Array("P","S")
If wsData.Cells(m,c) <> CStr(wsReport.Cells(iRow,c).Value) Then
wsData.Cells(m,c) = CStr(wsReport.Cells(iRow,c).Value)
wsData.Cells(m,c).Interior.Color = vbGreen
iUpdate = iUpdate + 1
End If
Next
Debug.Print iRow,"Match row " & m 'Match row:if the line already exists in the file
End If
Next
MsgBox wsReport.Name & " scanned from row " & iStartRow & _
" to " & iLastRow & vbCrLf & "added rows = " & iAdd & vbCrLf & _
"updated cells = " & iUpdate,sFilename
wbReport.Close False 'Close the Report
End Sub