snasui.com ยินดีต้อนรับ ยินดีต้อนรับสู่กระดานถามตอบ Excel and VBA และอื่น ๆ ที่เป็นมิตรกับทุกท่าน มีไฟล์แนบมหาศาล ช่วยให้ท่านค้นหาและติดตามศึกษาได้โดยง่าย สมาชิกท่านใดที่ยังไม่ได้ระบุ Version ของ Excel ที่ใช้งานจริง สามารถทำตาม Link นี้เพื่อจะได้รับคำตอบที่ตรงกับ Version ของท่านครับ ระบุ Version ของ Excel
โปรดชี้แนะด้วยครับ
ต้องขอโทษด้วยครับ กลัวท่านจะไม่ได้กลับมาอ่านเพราะโพสต์ไว้ตั้งแต่วันศุกร์ครับ
Private Sub CmdConvrt_Click()
Dim Handle As Integer, File_Name As String
Dim WriteRow As Long, TemArr, OneLine As String
Dim price1, price2, price3 As String
Handle = FreeFile
File_Name = "D:\Testrun.txt"
Open File_Name For Input As #Handle
Do While Not EOF(Handle)
Line Input #Handle, OneLine
TemArr = Split(OneLine, "|")
If UBound(TemArr) > 1 Then
WriteRow = WriteRow + 1
Cells(WriteRow, 1) = TemArr(0)
Cells(WriteRow, 2) = TemArr(1)
Cells(WriteRow, 3) = TemArr(2)
Cells(WriteRow, 4) = TemArr(4)
Cells(WriteRow, 5) = TemArr(5)
Cells(WriteRow, 6) = TemArr(5)
Cells(WriteRow, 7) = TemArr(7)
Cells(WriteRow, 8) = TemArr(8)
Cells(WriteRow, 9) = TemArr(9)
If TemArr(29) = "S225-1-1011-001" Then
Cells(WriteRow, 10) = Txtprc1.Value
Cells(WriteRow, 11) = TemArr(8) * Txtprc1
ElseIf TemArr(29) = "S225-1-1211-002" Then
Cells(WriteRow, 10) = Txtprc2.Value
Cells(WriteRow, 11) = TemArr(8) * Txtprc2
ElseIf TemArr(29) = "S225-1-DUMM-001" Then
Cells(WriteRow, 10) = Txtprc3.Value
Cells(WriteRow, 11) = TemArr(8) * Txtprc3
End If
'Cells(WriteRow, 11) = TemArr(8) * DC
Cells(WriteRow, 12) = TemArr(9)
Cells(WriteRow, 13) = TemArr(24)
Cells(WriteRow, 14) = TemArr(25)
Cells(WriteRow, 15) = TemArr(26)
End If
Loop
Close #Handle
End Sub
Private Sub CmdSavefiles_Click()
ActiveWorkbook.SaveAs Filename:= _
"D:\testrun.txt", FileFormat:= _
xlTextMSDOS, CreateBackup:=False
End Sub
Private Sub RefEdit1_BeforeDragOver(Cancel As Boolean, ByVal Data As MSForms.DataObject, ByVal x As stdole.OLE_XPOS_CONTAINER, ByVal y As stdole.OLE_YPOS_CONTAINER, ByVal DragState As MSForms.fmDragState, Effect As MSForms.fmDropEffect, ByVal Shift As Integer)
End Sub
Private Sub Txtprc1_Change()
If Me.Txtprc1.Value = blank Then Exit Sub
With Me.Txtprc1
chkval = Application.WorksheetFunction.IsNumber(Evaluate(Me.Txtprc1.Value))
If chkval = False Then
MsgBox (" Input only number.")
.Value = Left(.Value, Len(.Value) - 1)
End If
End With
End Sub
Private Sub Txtprc2_Change()
If Me.Txtprc2.Value = blank Then Exit Sub
With Me.Txtprc2
chkval = Application.WorksheetFunction.IsNumber(Evaluate(Me.Txtprc2.Value))
If chkval = False Then
MsgBox (" Input only number.")
.Value = Left(.Value, Len(.Value) - 1)
End If
End With
End Sub
Private Sub Txtprc3_Change()
If Me.Txtprc3.Value = blank Then Exit Sub
With Me.Txtprc3
chkval = Application.WorksheetFunction.IsNumber(Evaluate(Me.Txtprc3.Value))
If chkval = False Then
MsgBox (" Input only number.")
.Value = Left(.Value, Len(.Value) - 1)
End If
End With
End Sub
Private Sub Txtprc1_Change()
If Me.Txtprc1.Value = "" Then Exit Sub
With Me.Txtprc1
If Not .Text Like "#" Then
MsgBox (" Input only number.")
.Value = ""
End If
End With
End Sub
Private Sub Txtprc1_Change()
If Me.Txtprc1.Value = "" Then Exit Sub
With Me.Txtprc1
If Not Right(.Text, 1) Like "#" And Right(.Text, 1) <> "." Then
MsgBox (" Input only number.")
.Value = Left(.Value, Len(.Value) - 1)
End If
End With
End Sub
Private Sub Txtprc1_Change()
If Me.Txtprc1.Value = "" Then Exit Sub
On Error Resume Next
With Me.Txtprc1
chkval = Evaluate(.Value)
If Left(chkval, 5) = "Error" Then
MsgBox (" Input only number.")
.Value = Left(.Value, Len(.Value) - 1)
End If
End With
End Sub
Private Sub CmdConvrt_Click()
Dim Handle As Integer, File_Name As String
Dim WriteRow As Long, TemArr, OneLine As String
Dim Price1, Price2, Price3 As String
Dim Pono() As Variant
Dim Invno() As String
Dim Chkval As Integer
Dim Sump1 As Integer
Dim Sump2 As Integer
Dim Sump3 As Integer
Dim Sumpr As Integer
Dim Sumprice As Integer
Handle = FreeFile
File_Name = "D:\testrun.txt"
Open File_Name For Input As #Handle
Do While Not EOF(Handle)
Line Input #Handle, OneLine
TemArr = Split(OneLine, "|")
If UBound(TemArr) > 1 Then
WriteRow = WriteRow + 1
Cells(WriteRow, 1) = "VMI050"
Cells(WriteRow, 2) = TemArr(1)
Cells(WriteRow, 3) = TemArr(2)
'Pono = TemArr(4)
Cells(WriteRow, 4) = TemArr(4)
Cells(WriteRow, 5) = TemArr(5)
Cells(WriteRow, 6) = TemArr(5)
Cells(WriteRow, 7) = TemArr(7)
Cells(WriteRow, 8) = TemArr(8)
Cells(WriteRow, 9) = " PC"
If TemArr(4) = 9999999999# Then
Cells(WriteRow, 9) = " "
Cells(WriteRow, 11) = Sumprice
End If
If TemArr(29) = "S225-1-1011-001" Then
Cells(WriteRow, 10) = Txtprc1.Value
Cells(WriteRow, 11) = TemArr(8) * Txtprc1
Sump1 = Cells(WriteRow, 11)
ElseIf TemArr(29) = "S225-1-1211-002" Then
Cells(WriteRow, 10) = Txtprc2.Value
Cells(WriteRow, 11) = TemArr(8) * Txtprc2
Sump2 = Cells(WriteRow, 11)
ElseIf TemArr(29) = "S225-1-DUMM-001" Then
Cells(WriteRow, 10) = Txtprc3.Value
Cells(WriteRow, 11) = TemArr(8) * Txtprc3
Sump3 = Cells(WriteRow, 11)
End If
'Cells(WriteRow, 11) = TemArr(8) * DC
Cells(WriteRow, 12) = TemArr(9)
Cells(WriteRow, 13) = TemArr(24)
Cells(WriteRow, 14) = TemArr(25)
Cells(WriteRow, 15) = TemArr(26)
Sumpr = Sump1 + Sump2 + Sump3
'Sumprice = Sumpr + Sumprice
'Sumprice = Sumprice + Sumpr
End If
'Sumprice = Sumprice + Sumpr
Loop
Close #Handle
End Sub
Private Sub CmdSavefiles_Click()
ActiveWorkbook.SaveAs Filename:= _
"D:\testfile.txt", FileFormat:= _
xlTextMSDOS, CreateBackup:=False
End Sub
Private Sub RefEdit1_BeforeDragOver(Cancel As Boolean, ByVal Data As MSForms.DataObject, ByVal x As stdole.OLE_XPOS_CONTAINER, ByVal y As stdole.OLE_YPOS_CONTAINER, ByVal DragState As MSForms.fmDragState, Effect As MSForms.fmDropEffect, ByVal Shift As Integer)
End Sub
Private Sub Txtprc1_Change()
If Me.Txtprc1.Value = "" Then Exit Sub
On Error Resume Next
With Me.Txtprc1
Chkval = Evaluate(.Value)
If Left(Chkval, 5) = "Error" Then
MsgBox (" Input only number.")
.Value = Left(.Value, Len(.Value) - 1)
End If
End With
End Sub
Private Sub Txtprc2_Change()
If Me.Txtprc2.Value = "" Then Exit Sub
On Error Resume Next
With Me.Txtprc2
Chkval = Evaluate(.Value)
If Left(Chkval, 5) = "Error" Then
MsgBox (" Input only number.")
.Value = Left(.Value, Len(.Value) - 1)
End If
End With
End Sub
Private Sub Txtprc3_Change()
If Me.Txtprc3.Value = "" Then Exit Sub
On Error Resume Next
With Me.Txtprc3
Chkval = Evaluate(.Value)
If Left(Chkval, 5) = "Error" Then
MsgBox (" Input only number.")
.Value = Left(.Value, Len(.Value) - 1)
End If
End With
End Sub
snasui.com ยินดีต้อนรับ 
สมาชิกท่านใดที่ยังไม่ได้ระบุ Version ของ Excel ที่ใช้งานจริง สามารถทำตาม Link นี้เพื่อจะได้รับคำตอบที่ตรงกับ Version ของท่านครับ 
โปรดทราบ 
แนบมาเป็น Excel และแสดงให้เห็นว่าบรรทัดรวมอยู่คอลัมน์ไหน เซลล์ไหนครับ