VBA Excel技术问题：无法按BUKRS字段分配SAP LSMW加载文件数据

我仔细看了你的VBA代码，问题出在几个核心逻辑上，导致所有数据都跑到05-Vend-Loadcache(No WHTAX).xls里，而且HLookup的用法也不符合你的需求。咱们一步步拆解修复：

先揪出代码里的关键bug #

1. HLookup获取BUKRS值的逻辑完全错误

你用CCD = Application.WorksheetFunction.HLookup("BUKRS", DTA.Range("A1:IV2"), 2, 0)，这里有两个致命问题：

• HLookup是按行横向查找表头，然后返回指定行的值，但你只在工作表前两行（A1:IV2）里查找一次，拿到的是第二行对应BUKRS列的固定值，不是逐行获取当前数据行的BUKRS值。这就导致所有行都用同一个CCD判断，自然全进了同一个文件。
• 用HLookup定位表头列本身就不靠谱，一旦表头位置变动，很容易匹配失败。

2. CCE的取值也是固定的，不是当前行数据

你写的CCE = DTA.Cells(1, 60)是取第1行第60列的表头值，不是当前处理数据行的第60列值，这会导致后续的条件判断完全失效。

3. 导出条件的逻辑冗余且有漏洞

你的两个If判断只在特定CCE值且对应文件时才导出，但如果CCD符合WHTAX条件但CCE不是"LNRZB"，就直接跳过了，这可能和你想要的导出逻辑不符。

修复后的完整代码 #

Sub VENDOR()
    Dim DTA As Worksheet
    Dim currentRow As Long
    Dim bukrsCol As Integer ' 存储BUKRS表头所在的列号
    Dim CCD As Variant ' 存储当前行的BUKRS值
    Dim CCE As String ' 存储当前行第60列的值
    Dim WFNA As String
    
    ' 先绑定数据工作表（改成你实际的工作表名，比如"数据源"）
    Set DTA = ThisWorkbook.Sheets("你的数据工作表名")
    
    ' 先定位BUKRS表头所在列，比HLookup可靠100倍
    On Error Resume Next
    bukrsCol = DTA.Rows(1).Find(What:="BUKRS", LookIn:=xlValues, LookAt:=xlWhole).Column
    On Error GoTo 0
    If bukrsCol = 0 Then
        MsgBox "没找到BUKRS表头，请检查数据格式！", vbExclamation
        Exit Sub
    End If
    
    ' 遍历所有数据行（假设表头在第1行，数据从第2行开始）
    For currentRow = 2 To DTA.Cells(DTA.Rows.Count, bukrsCol).End(xlUp).Row
        ' 获取当前行的BUKRS值
        CCD = DTA.Cells(currentRow, bukrsCol).Value
        ' 获取当前行第60列的值（改成你实际需要的列逻辑，如果不是固定60列可以同理用Find定位）
        CCE = DTA.Cells(currentRow, 60).Value
        
        ' 根据BUKRS值确定目标文件
        WFNA = "05-Vend-Loadcache(No WHTAX).xls"
        Select Case CCD
            Case 9000, 5500, 6200, 8400, 8600, 8500 ' 如果BUKRS是文本型就加引号："9000"
                WFNA = "06-Vend-Loadcache(WHTAX).xls"
        End Select
        
        ' 按目标文件匹配对应的导出条件
        Select Case WFNA
            Case "05-Vend-Loadcache(No WHTAX).xls"
                If CCE = "" Or CCE = "CC3200" Or CCE = "VERKF" Or CCE = "TELF1" Or CCE = "KZRET" Then
                    ' 这里要确保EXPORTDTA能接收当前行和目标文件参数，可能需要修改EXPORTDTA
                    Call EXPORTDTA(currentRow, WFNA, DTA)
                End If
            Case "06-Vend-Loadcache(WHTAX).xls"
                If CCE = "LNRZB" Then
                    Call EXPORTDTA(currentRow, WFNA, DTA)
                End If
        End Select
    Next currentRow
End Sub

' 配套修改EXPORTDTA过程，接收参数处理导出
Sub EXPORTDTA(rowNum As Long, targetFile As String, sourceSheet As Worksheet)
    ' 这里写你的导出逻辑：比如把sourceSheet的rowNum行数据复制到targetFile的对应工作表
    ' 示例逻辑（根据你的实际需求调整）：
    Dim targetWB As Workbook
    On Error Resume Next
    Set targetWB = Workbooks(targetFile)
    On Error GoTo 0
    If targetWB Is Nothing Then
        Set targetWB = Workbooks.Open(ThisWorkbook.Path & "\" & targetFile) ' 假设文件在同目录
    End If
    sourceSheet.Rows(rowNum).Copy targetWB.Sheets("BISOVSH").Cells(targetWB.Sheets("BISOVSH").Rows.Count, 1).End(xlUp).Offset(1, 0)
    targetWB.Save
End Sub

关键修复点说明 #

1. 准确定位BUKRS列：用Rows(1).Find替代HLookup，不管表头在第几列都能精准找到，避免匹配错误。
2. 逐行处理数据：添加For currentRow循环，遍历每一行数据，这样每行的CCD和CCE都是当前行的真实值，这是解决所有数据进同一个文件的核心！
3. 优化导出条件逻辑：用Select Case替代嵌套If，逻辑更清晰，避免冗余判断。
4. 完善EXPORTDTA的参数传递：让导出过程能接收当前行和目标文件，确保数据能正确写入对应文件。

内容的提问来源于stack exchange，提问作者user9799161