数据导入时内容重叠

Question

我正在使用 Excel VBA 做一个项目，但在导入数据时遇到了问题。每次我导入数据时，它都会与现有列重叠。

有人可以帮我解决这个问题吗，下面是代码。

Private Sub CommandButton1_Click()

Dim myFile As String, text As String, textline As String, Name As Integer, Phone As Integer, Address1 As Integer, Dated As Integer
Dim Email As Integer, Postcode As Integer, SR As Integer, MTM As Integer, Serial As Integer, Problem As Integer, Action As Integer


myFile = "C:\Users\test.txt"


Open myFile For Input As #1
    Do Until EOF(1)
        Line Input #1, textline
        text = text & textline
    Loop
Close #1

Name = InStr(text, "Name")
Phone = InStr(text, "Phone")
Address1 = InStr(text, "Address1")
Email = InStr(text, "Email")
Postcode = InStr(text, "Postcode")
SR = InStr(text, "SR")
MTM = InStr(text, "MTM")
Serial = InStr(text, "Serial")
Problem = InStr(text, "Problem")
Action = InStr(text, "Action")
Dated = InStr(text, "Dated")


Range("C11").Value = Mid(text, Name + 6, 15)
Range("H13").Value = Mid(text, Phone + 6, 8)
Range("C15").Value = Mid(text, Address1 + 9, 25)
Range("C13").Value = Mid(text, Email + 6, 15)
Range("H16").Value = Mid(text, Postcode + 9, 5)
Range("C10").Value = Mid(text, SR + 4, 8)
Range("H14").Value = Mid(text, MTM + 5, 8)
Range("H15").Value = Mid(text, Serial + 8, 9)
Range("C17").Value = Mid(text, Problem + 9, 15)
Range("C18").Value = Mid(text, Action + 7, 10)
Range("H10").Value = Mid(text, Dated + 7, 10)

End Sub

在附表中查找数据。手机跳转到名称列，其他列也是如此。H13 中的数据同样跳转到 C11。

---

。

编辑

---

嗨，保罗，我仍然遇到打印和将表格​​转换为 PDF 的问题。

如果不使用您的第一个或第二个代码，我可以运行以下代码并将工作表转换为 PDF，但是现在，在运行您的第一个和第二个代码后，以下代码无法将工作表转换为 PDF...我一直收到“应用程序定义或对象定义的错误”和运行时错误'1004'文档未保存。文档可能已打开，或者保存时可能遇到错误。

我可以知道我的代码有什么问题吗？

Private Sub CommandButton2_Click()
    Dim FilePath As String
    Dim FileName As String
    Dim MyDate As String
    Dim report As String
    Dim Name As String

    FilePath = "C:\Users\Documents\test\"
    MyDate = Format(Date, " - MM-DD-YYYY")
    report = " - Quatation"
    Name = Worksheets("Sheet1").Range("C10")

    Sheets("Sheet1").Range("A1:I60").ExportAsFixedFormat Type:=xlTypePDF, _
        FileName:=FilePath & Name & MyDate & report
End Sub

---

Private Sub report()
    Dim myFile As String, lastRow As Long
    myFile = "C:\Users\Documents\test\" & Sheets("Sheet1").Range("C11") & "_" & Sheets("Sheet1").Range("C17") & Format(Now(), "yyyy-mm-dd") & ".pdf"
    lastRow = Sheets("Sheet3").UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1
    'Transfer data to sheet3
    Sheets("Sheet3").Cells(lastRow, 1) = Sheets("Sheet1").Range("C11")
    Sheets("Sheet3").Cells(lastRow, 2) = Sheets("Sheet1").Range("C17")
    Sheets("Sheet3").Cells(lastRow, 3) = Sheets("sheet1").Range("I28")
    Sheets("Sheet3").Cells(lastRow, 4) = Now
    Sheets("Sheet3").Hyperlinks.Add Anchor:=Sheets("Sheet3").Cells(lastRow, 5), Address:=myFile, TextToDisplay:=myFile
    'Create invoice in PDF format
    Sheets("sheet1").ExportAsFixedFormat Type:=xlTypePDF, FileName:=myFile
    Application.DisplayAlerts = False
    'create invoice in XLSX format
    ActiveWorkbook.SaveAs "C:\Users\Documents\test\" & Sheets("Sheet1").Range("C11") & "_" & Sheets("Sheet1").Range("C17") & "_" & Format(Now(), "yyyy-mm-dd") & ".xlsx", FileFormat:=51
    'ActiveWorkbook.Close
    Application.DisplayAlerts = True
End Sub

---

Answer 1

你可以让代码更高效、更易于维护、更动态

下面的两个版本根据下一个标记的位置确定数据的大小（"Phone"）
相对于当前 token（"Name"）

---

。

版本 1使用数组将 token 映射到不同的单元格Sheet5

Option Explicit

Private Sub CommandButton1_Click()

    Const FULL_PATH = "C:\Users\test1.txt"

    Const TOKENS = "Name Phone Address1 Email Postcode SR MTM Serial Problem Action Dated"
    Const LOCATIONS = "C11 H13 C15 C13 H16 C10 H14 H15 C17 C18 H10"

    Dim fId As String, txt As String, txtLen As Long, idArr As Variant, locArr As Variant

    fId = FreeFile
    Open FULL_PATH For Input As fId
        txt = Input(LOF(fId), fId)  'Read entire file (not line-by-line)
    Close fId
    txtLen = Len(txt)

    idArr = Split(TOKENS)
    locArr = Split(LOCATIONS)

    Dim i As Long, k As String, sz As Long, found As Long, ub As Long

    ub = UBound(idArr)

    With ThisWorkbook.Worksheets("Sheet5")     '<--- Update sheet name
        For i = LBound(idArr) To ub
            k = idArr(i)        'Name, Phone, etc
            found = InStr(txt, k) + Len(k) + 1  'Find current key in file
            If found > 0 Then   'Determine item length by finding the next key
                If i < ub Then sz = InStr(txt, idArr(i + 1)) Else sz = txtLen + 2
                .Range(locArr(i)).Value2 = Trim$(Mid$(txt, found, sz - found - 1))
            End If
        Next
    End With
End Sub

---

。

版本 2使用字典

Private Sub CommandButton1_Click()
    Const FULL_PATH = "C:\Users\test2.txt"
    Dim fId As String, txt As String, txtLen As Long, d As Object, dc As Long

    fId = FreeFile
    Open FULL_PATH For Input As fId
        txt = Input(LOF(fId), fId)  'Read entire file (not line-by-line)
    Close fId
    txtLen = Len(txt)
    Set d = CreateObject("Scripting.Dictionary")
    d("Name") = "C11"   'Same as: d.Add Key:="Name", Item:="C11"
    d("Phone") = "H13"
    d("Address1") = "C15"
    d("Email") = "C13"
    d("Postcode") = "H16"
    d("SR") = "C10"
    d("MTM") = "H14"
    d("Serial") = "H15"
    d("Problem") = "C17"
    d("Action") = "C18"
    d("Dated") = "H10"
    dc = d.Count

    Dim i As Long, k As String, sz As Long, found As Long
    With ThisWorkbook.Worksheets("Sheet5")     '<--- Update sheet name
        For i = 0 To dc - 1     'd.Keys()(i) is a 0-based array
            k = d.Keys()(i)     'Name, Phone, etc
            found = InStr(txt, k) + Len(k) + 1  'Find the (first) key in file
            If found > 0 Then   'Determine item length by finding the next key
                If i < dc - 1 Then sz = InStr(txt, d.Keys()(i + 1)) Else sz = txtLen + 2
                .Range(d(k)).Value2 = Trim$(Mid$(txt, found, sz - found - 1))
            End If
        Next
    End With
End Sub

---

。

测试1.txt

Name Name1
Phone Phone1
Address1 Address11
Email Email1
Postcode Postcode1
SR SR1
MTM MTM1
Serial Serial1
Problem Problem1
Action Action1
Dated Dated1

结果 1：

。

测试2.txt

Name Name2 Phone Phone2 Address1 Address12 Email Email2 Postcode Postcode2 SR SR2 MTM MTM2 Serial Serial2 Problem Problem2 Action Action2 Dated Dated2

结果 2：

---