用excel vba实现目标列的比较和更新

ajsxfq5m  于 2023-06-25  发布在  其他
关注(0)|答案(1)|浏览(118)

这是我的代码。它说匹配没有找到.我共享的代码和上传的文件数据以及.

Option Explicit

Sub UpdateMasterWorksheet()
    Dim xlApp As Application
    Dim intFF As Integer
    Dim strFileName As String
    Dim vntFileName As Variant
    Dim importedData() As Variant
    Dim InputCSVSheet As Worksheet
    Dim importedColumnG As Range
    Dim masterColumnA As Range
    Dim i As Long
    Dim matchFound As Boolean ' Flag to track if a match is found
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.EnableEvents = False
        
    Call SetASheetName
    
    ' Prompt user to select a file
    Set xlApp = Application
    vntFileName = xlApp.GetOpenFilename(FileFilter:="All Files (*.*), *.*", Title:="Select File to Import")
    
    ' Check if a file is selected
    If VarType(vntFileName) = vbBoolean Then
        MsgBox "No file selected. Import canceled.", vbExclamation
        Exit Sub
    End If
    
    ' Get selected file name
    strFileName = vntFileName
    
    ' Read data from the file into an array
    intFF = FreeFile
    Open strFileName For Binary Access Read As intFF
    
    ' Read the file content into a byte array
    Dim fileContentBytes() As Byte
    ReDim fileContentBytes(LOF(intFF) - 1)
    Get #intFF, , fileContentBytes
    Close intFF
    
    ' Convert the byte array to a string
    Dim fileContent As String
    fileContent = StrConv(fileContentBytes, vbUnicode)
    
    ' Split the file content into an array of lines
    Dim fileLines() As String
    fileLines = Split(fileContent, vbCrLf)
    
    ' Resize the importedData array to match the number of lines
    ReDim importedData(1 To UBound(fileLines) + 1, 1 To 1)
    
    ' Fill the importedData array with the file lines
    For i = 0 To UBound(fileLines)
        importedData(i + 1, 1) = fileLines(i)
    Next i
    
    ' Set references to the InputCSVSheet and the respective columns
    Set InputCSVSheet = ThisWorkbook.Sheets("InputData") ' Replace "InputData" with your actual sheet name
    Set importedColumnG = InputCSVSheet.Range("G14:G" & InputCSVSheet.Cells(Rows.Count, "G").End(xlUp).row)
    Set masterColumnA = InputCSVSheet.Range("A14:A" & InputCSVSheet.Cells(Rows.Count, "A").End(xlUp).row)
    
    ' Loop through the imported data
    For i = LBound(importedData, 1) To UBound(importedData, 1)
        ' Extract the second value from the importedData array
        Dim importedValues() As String
        importedValues = Split(importedData(i, 1), ",")
        
        If UBound(importedValues) >= 1 Then
            Dim importedValue As String
            importedValue = Trim(importedValues(1))
            
            ' Find matching values in column G of the InputCSVSheet
            Dim matchCell As Range
            Set matchCell = importedColumnG.Find(importedValue, LookIn:=xlValues, LookAt:=xlWhole)
            
            ' If a match is found, update the corresponding cell in column A with the last value from the imported file
            If Not matchCell Is Nothing Then
                Dim lastValue As String
                lastValue = Trim(importedValues(UBound(importedValues)))
                
                ' Update the corresponding cell in column A with the last value from the imported file
                masterColumnA.Cells(matchCell.row).Value = lastValue
                
                matchFound = True ' Set the flag indicating a match is found
            End If
        End If
    Next i
    
    ' Check if a match was found or not
    If Not matchFound Then
        MsgBox "No match found in the worksheet.", vbInformation
    End If
    ' Close the opened text file workbook without saving changes
    
    Close intFF
    
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    
    MsgBox "Data imported and master worksheet updated successfully.", vbInformation
End Sub

' シート名の設定
Public Sub SetASheetName()
    Set InputCSVSheet = Worksheets("InputData") ' Replace "InputData" with your actual sheet name
End Sub

谢谢你。
“我想将InputData工作表的G列中的数据与上传的CSV文件中的第二个值(1,2,3,4,5,6)进行比较。如果有匹配项,我想将上传文件的第6列中的相应值复制到InputData的第A列。我已经包括代码和数据从文件上传。但是,当我运行代码时,它会显示'match not found'作为结果。”
上载的数据188215,% 1,% 1,错误,,指定的存储代码无效。[01][00188215] 188215,1,1,错误,,指定的代码未在产品中注册188215,1,1,错误,,产品代码未在设置的产品中注册188220,2,1,错误,,指定的商店代码无效。[01][00188220]

x8diyxa7

x8diyxa71#

Sub AmazonErrorImport()'将文本导入Excel

' Variable declaration
Dim xlApp As Application        ' Application object
Dim intFF As Integer            ' FreeFile value
Dim strFileName As String       ' File name to open (full path)
Dim vntFileName As Variant      ' File name received
Dim strCurFolder As String      ' Backup of the current folder
Dim fileToOpen As Variant
Dim fileFilterPattern As String
Dim InputCSVSheet As Worksheet

' Disable screen updating, alerts, events, and set manual calculation mode
Application.ScreenUpdating = False
Application.DisplayAlerts = False ' Disable confirmation messages
Application.EnableEvents = False ' Disable events
Application.Calculation = xlCalculationManual ' Set manual calculation mode

' Set filter to display text/CSV files
readFrom = "2"

' Set sheet name
Call SetSheetName

' Header row of the input file
InputHeadLine = 1

' Get Application object
Set xlApp = Application

' Output message (file selection)
xlApp.StatusBar = MsgFileSelect

' Backup the current folder (to change the current folder for file selection)
strCurFolder = CurDir

' Set initial folder for file selection
ChDir ThisWorkbook.Path & "\"

' Receive the file name specified in the "Open File" dialog form
vntFileName = xlApp.GetOpenFilename(FileFilter:=cnsFILTER, Title:=cnsTITLE, MultiSelect:=False)

' Restore the current folder
ChDir strCurFolder

' If canceled, exit the subroutine
If VarType(vntFileName) = vbBoolean Then Exit Sub
strFileName = vntFileName

' Clear header row count
InputHeadCnt = 0

' Clear read count
InputCnt = 0

' Clear order count
EdtRecCnt = 0

' Get FreeFile value
intFF = FreeFile

' Open the specified file (in input mode)
Open strFileName For Input As intFF

' Add to the existing worksheet
Set InputCSVSheet = ThisWorkbook.Worksheets("InputData")

' Copy the data to the import worksheet
Dim ImportedWorkbook As Workbook
Set ImportedWorkbook = xlApp.Workbooks.Open(strFileName)
Dim importRange As Range
Dim importValues As Variant
Dim importValue As String
Dim inputColumnG As Range
Dim inputColumnGValues As Variant
Dim completed As Boolean

completed = False

With ImportedWorkbook.Worksheets(1)
    Set importRange = .UsedRange
    importValues = importRange.Value
End With

Set workingRange = InputCSVSheet.Range("A3")
inputColumnGValues = InputCSVSheet.Columns("G").Value

Dim i As Long
Dim lastRow As Long
lastRow = UBound(importValues, 1)

For i = 2 To lastRow
    importValue = Trim(importValues(i, 2))
    
    Set inputColumnG = InputCSVSheet.Columns("G").Find(importValue, LookIn:=xlValues, LookAt:=xlWhole)
    
    If Not inputColumnG Is Nothing Then ' Value matches
        If InputCSVSheet.Range("A" & inputColumnG.Row).Value = "" Then
            InputCSVSheet.Range("A" & inputColumnG.Row).Value = importValues(i, 6)
        Else
            InputCSVSheet.Range("A" & inputColumnG.Row).Value = InputCSVSheet.Range("A" & inputColumnG.Row).Value & "  " & importValues(i, 6)
        End If
        
        completed = True ' Completion flag
    End If
Next i

' Close the opened text file workbook without saving if there were changes
ImportedWorkbook.Close False

' Resume screen updating, alerts, events, and automatic calculation mode
Application.ScreenUpdating = True
Application.DisplayAlerts = True ' Enable confirmation messages
Application.EnableEvents = True ' Enable events
Application.Calculation = xlCalculationAutomatic ' Set automatic calculation mode

' Completion message
If completed Then
    MsgBox "File upload completed."
Else
    MsgBox "File upload failed."
End If

结束子
此代码正在运行。谢谢大家

相关问题