Dear Teman,
Aku ada buat makro untuk menyalin data dari txt file (contoh saya attached) ke
excel tapi saya ada kesulitan waktu masuk kepilihan "DTL02" yang terdapat
lebih dari satu detail (DTL02SNM, DTL02CNA dan seterusnya) tolong dibantu dung
gimana cara mecahin data nya
Terima/Kasih
Public BLNumber As String
Public CNTNumber As String
Public DOKNumber As String
Public DOKNumber2 As String
Public DOKNumber3 As String
Public pol As String
Public pod As String
Public desc As String
Public Cgn As String
Public Ntf As String
Public IntCounter As Integer
Public NextColumn As Integer
Function Test(strMSG As String)
strHDR = Mid(strMSG, 1, 3)
Select Case strHDR
Case "DTL01"
BLNumber = Trim(Mid(Text_Data, 90, 20))
'IntCounter = 1
Case "CNT01"
CNTNumber = Trim(Mid(Text_Data, 10, 20))
Cells(IntCounter, NextColumn).Value = CNTNumber
Cells(IntCounter, NextColumn + 1).Value = BLNumber
Cells(IntCounter, NextColumn + 2).Value = pol
Cells(IntCounter, NextColumn + 3).Value = pod
Cells(IntCounter, NextColumn + 4).Value = DOKNumber
Cells(IntCounter, NextColumn + 5).Value = DOKNumber2
Cells(IntCounter, NextColumn + 6).Value = DOKNumber3
Cells(IntCounter, NextColumn + 7).Value = desc
Cells(IntCounter, NextColumn + 8).Value = Cgn
Cells(IntCounter, NextColumn + 9).Value = Ntf
End Select
End Function
Private Sub CommandButton1_Click()
Dim lngCount As Long
' Open the file dialog
With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = True
.Show
' Display paths of each file selected
For lngCount = 1 To .SelectedItems.Count
TextBox1.Text = .SelectedItems(lngCount)
' Label1.Caption = .SelectedItems(lngCount)
Next lngCount
End With
End Sub
Private Sub CommandButton2_Click()
On Error GoTo ERR_Handles
Const ForReading = 1, ForWriting = 2, ForAppending = 3
Dim fs, f, Retstring
Dim File_Name As String
Dim Text_Data As String
Dim BL As Integer
NextColumn = TextBox2.Text
File_Name = TextBox1.Text
Set fs = CreateObject("Scripting.FileSystemObject")
'Set Text_Stream = OFSO.OpenTextFile("J:\FLATFILES\SINARJAVA328\BL #
OOLU2001234660.txt", ForReading, False)
Set f = fs.OpenTextFile(File_Name, ForReading)
IntCounter = TextBox3.Text
Cells(IntCounter, NextColumn).Value = "CONTAINER NO"
Cells(IntCounter, NextColumn + 1).Value = "BL NO"
Cells(IntCounter, NextColumn + 2).Value = "POL"
Cells(IntCounter, NextColumn + 3).Value = "POD"
Cells(IntCounter, NextColumn + 4).Value = "KPBC"
Cells(IntCounter, NextColumn + 5).Value = "PEB No"
Cells(IntCounter, NextColumn + 6).Value = "DATE"
Cells(IntCounter, NextColumn + 7).Value = "desc"
Cells(IntCounter, NextColumn + 8).Value = "Cgn"
Cells(IntCounter, NextColumn + 9).Value = "Ntf"
IntCounter = IntCounter + 1
Do While f.AtEndOfStream <> True
Retstring = f.Readline
strHDR = Mid(Retstring, 1, 5)
Select Case strHDR
Case "DTL01"
BLNumber = Trim(Mid(Retstring, 90, 20))
pol = Trim(Mid(Retstring, 25, 5))
pod = Trim(Mid(Retstring, 30, 5))
'IntCounter = 1
Case "DTL02"
shp = Trim(Mid(Retstring, 6, 200))
Case "DOK01"
DOKNumber = Trim(Mid(Retstring, 12, 6))
DOKNumber2 = Trim(Mid(Retstring, 19, 5))
DOKNumber3 = Trim(Mid(Retstring, 24, 8))
Case "CNT01"
If Mid(Retstring, 14, 1) = Chr(32) Then
CNTNumber = Trim(Mid(Retstring, 10, 4)) & Trim(Mid(Retstring, 14, 14))
Cells(IntCounter, NextColumn).Value = CNTNumber
Cells(IntCounter, NextColumn + 1).Value = BLNumber
Cells(IntCounter, NextColumn + 2).Value = pol
Cells(IntCounter, NextColumn + 3).Value = pod
Cells(IntCounter, NextColumn + 4).Value = DOKNumber
Cells(IntCounter, NextColumn + 5).Value = DOKNumber2
Cells(IntCounter, NextColumn + 6).Value = DOKNumber3
Cells(IntCounter, NextColumn + 7).Value = desc
Cells(IntCounter, NextColumn + 8).Value = Cgn
Cells(IntCounter, NextColumn + 9).Value = Ntf
Else
CNTNumber = Trim(Mid(Retstring, 10, 20))
Cells(IntCounter, NextColumn).Value = CNTNumber
Cells(IntCounter, NextColumn + 1).Value = BLNumber
Cells(IntCounter, NextColumn + 2).Value = pol
Cells(IntCounter, NextColumn + 3).Value = pod
Cells(IntCounter, NextColumn + 4).Value = DOKNumber
Cells(IntCounter, NextColumn + 5).Value = DOKNumber2
Cells(IntCounter, NextColumn + 6).Value = DOKNumber3
Cells(IntCounter, NextColumn + 7).Value = desc
Cells(IntCounter, NextColumn + 8).Value = Cgn
Cells(IntCounter, NextColumn + 9).Value = Ntf
End If
IntCounter = IntCounter + 1
End Select
Loop
'Text_Stream.Close
f.Close
Set fs = Nothing
Unload Me
ERR_Handles:
Select Case Err.Number
Case 13
MsgBox "Isian Kurang Lengkap Atau Salah !", vbOKOnly, "Salin Kontainer"
End Select
End Sub
Private Sub UserForm_Click()
End Sub
HDR0111OSHERMES NM100N
20080519000000V30MEM31
DTL0109E00010000 IDTPPIDTPPLKCMBLKCMBCMA CGM ROSE V.NMS022N
12279-JKT-CMB 20080519S8100JKTCMB109
20080519
000000000026536000000000000075490000000020000017400000000000000000000000000RO
DTL02SNM01PT. SERIM INDONESIA
DTL02SNA01DESA CIJANTRA KEC. PAGEDANGAN TANGERANG INDONESIA
DTL02CNM01SINTESI LIMITED
DTL02CNA01#409, 3RD FLOOR, GALLE ROAD COLOMBO 03 SRI LANKA
DTL02NNM01SINTESI LIMITED
DTL02NNA01#409, 3RD FLOOR, GALLE ROAD COLOMBO 03 SRI LANKA
DTL02SMR01N/M
DTL02HSC01
DTL02DES013921.1300.00 174 ROLLS = 4,393 M OF : SOFT POLY URETHANE FOAM
DOK01PEB00104030024992520080517
CNT010000GATU8237554 40F 0102392
CNT010001DAYU2139082 20F 0102391
