डेटा आयात करते समय सामग्री ओवरलैप करना

मैं एक्सेल 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 में Data अन्य लोगों के समान C11 आ रहा है।

।

संपादित करें

हाय पॉल, मैं अभी भी छपाई और शीट को पीडीएफ में परिवर्तित करने के साथ जारी कर रहा हूं।

आपके पहले या दूसरे कोड का उपयोग किए बिना .. मैं नीचे दिए गए कोड और शीट को पीडीएफ में चला सकता हूं लेकिन अब जब पहले और दूसरे कोड को चलाने के बाद, नीचे दिए गए कोड शीट को पीडीएफ में नहीं बदल सकते ... मुझे मिलता रहा " एप्लिकेशन-डिफाइन्ड या ऑब्जेक्ट-डिफाइंड एरर ”और रन-टाइम एरर’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

microsoft-excel vba

— gist102
स्रोत

आपने अपर्याप्त जानकारी रखी है क्योंकि आपका वर्तमान कोड आपके द्वारा उपयोग किए जा रहे कोड का हिस्सा है। साथ ही कॉलम में क्या ओवरलैप है, यह समझाने में असमर्थ संलग्न पत्रक !! कृपया कोड को संपादित करें और शीट का पूरा लुक अपलोड करें।

— राजेश एस

यह पूरा कोड है

— gist102

मैंने पूरा कोड डाल दिया है। जैसा कि मैंने कहा कि कोड काम करता है लेकिन मेरा मुद्दा H13 डेटा कट रहा है और कुछ C11 पर आ रहे हैं। संलग्न चित्रों से पता चलता है कि "फोन" जो H13 कट का हिस्सा माना जाता है और कुछ c11 में हैं ..

— gist102

@ gist102 यदि आपके पास एक नया प्रश्न है (जो ऐसा दिखता है, क्योंकि मूल समस्या हल हो गई थी, तो आपने एक उत्तर स्वीकार किया, आपने नया कोड पोस्ट किया, और अब जो अतिरिक्त प्रश्न आपके पास है, उसका ओवरलैपिंग से कोई लेना-देना नहीं है), आप एक नया प्रश्न पूछना चाहिए। इस पोस्ट से संबंधित होने पर आप एक लिंक जोड़ सकते हैं। आप भी कर सकते हैं, जैसा कि आप पहले ही कर चुके हैं, उपयोगकर्ता को पिंग करने के लिए एक उत्तर पर एक टिप्पणी पोस्ट करें और नए प्रश्न को उनके ध्यान में लाएं। सुपर यूजर साइट कैसे काम करती है - प्रति प्रश्न एक प्रश्न। यह एक मंच नहीं है जहां आप अनुवर्ती प्रश्न पूछ सकते हैं।

— रोबिनटेक 11

आप कोड को अधिक कुशल, बनाए रखने योग्य और थोड़ा अधिक गतिशील बना सकते हैं

दो वर्जन के बॉक् स अगले टोकन के स्थान के आधार पर डेटा का आकार निर्धारित करते हैं ( "Phone")
वर्तमान टोकन के सापेक्ष ( "Name")

।

संस्करण 1 विभिन्न कोशिकाओं पर टोकन के मानचित्र के लिए सरणियों का उपयोग करता है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

।

test1.txt

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

परिणाम 1 :

।

test2.txt

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

परिणाम 2 :

— पौल बिका
स्रोत

हाय पॉल, हर बार जब मैं कोड चलाता हूं, तो मुझे निम्न त्रुटि "रन-टाइम त्रुटि '9'

— मिलेगी: अंश से

कौन सी लाइन त्रुटि फेंकता है? (ऊपर आने पर "डीबग" बटन पर क्लिक करें)। इसके अलावा, सुनिश्चित करें कि आप उस लाइन पर शीट का नाम अपडेट करते हैं , जहां आप यह टिप्पणी देखते हैं'<--- Update sheet name

— paul bica

हाँ, मैंने किया और यह काम करता है .. उस सहायता के लिए धन्यवाद .. वास्तव में इसकी सराहना करते हैं।

— gist102

मुझे पॉल कोडिंग का आपका पैटर्न पसंद है .. क्या आपके पास एक चैनल है जो आपको यू से अधिक सीखना पसंद करेगा या शायद यू से एक ट्यूटर प्राप्त कर सकता है

— gist102

यदि आप मेरी प्रोफ़ाइल देखते हैं, तो आप उन उत्तरों की सूची के माध्यम से जा सकते हैं जो मैंने SU, SO, और CodeReview पर दिए हैं। बेझिझक किसी भी प्रश्न को पूछें और मुझे सूचित करें - जैसे ही मेरे पास कुछ खाली समय होगा, मैं जवाब दूंगा

— paul bica