EXCEL TOOLS
Excel Add-ins ที่พัฒนาโดยคุณสันติพงศ์ ณสุย (MVP Excel 2010-2020) ด้วยภาษา C# เพื่อแก้ไขปัญหาไฟล์ใหญ่ คำนวณนาน ทำงานช้า จัดการข้อมูลต่าง ๆ ที่ทำงานประจำวันได้อย่างสะดวกรวดเร็ว สนใจคลิกไปดูได้ที่นี่ครับ => Excel Tools
snasui.com ยินดีต้อนรับ 
สมาชิกท่านใดที่ยังไม่ได้ระบุ Version ของ Excel ที่ใช้งานจริง สามารถทำตาม Link นี้เพื่อจะได้รับคำตอบที่ตรงกับ Version ของท่านครับ 
โปรดทราบ 
วันนี้มีเรื่องสอบถามเกี่ยวกับ VBA Macro ค่ะ ซึ่งไฟล์นี้เป็นไฟล์ที่มีคนทำไว้แล้ว แต่ตอนนี้ไม่สามารถติดต่อพี่คนทำได้ค่ะ เนื่องจากคำอธิบายรายการในคอลัมน์ N ในSheet Result1 บางรายการข้อมูลมาไม่ครบค่ะ ซึ่งตัวอย่างรายการที่มาไม่ครบ ได้ทำการไฮไลท์ Row สีเหลืองไว้ค่ะ ซึ่งอยากจะทราบว่าถ้าต้องการให้ข้อมูลมาครบทุกรายการ จะต้องไปเปลี่ยนสูตรตรงไหนคะ
- ข้อมูล .txt ที่เอามารันข้อมูล อยู่ที่ Sheet "Ora_text"
Code: Select all
Option Explicit
Sub Go_Back()
Sheets("Menu").Activate
Range("A1").Activate
End Sub
Sub Go_Result()
Sheets("Result1").Activate
Range("A1").Activate
End Sub
Sub Go_Template()
Sheets("template").Activate
Range("A1").Activate
End Sub
Sub Clear_Data()
Application.ScreenUpdating = False
' clear sheet template
Sheets("result1").Activate
Range("A2:AZ1048570").ClearContents
Range("A2").Activate
' clear sheet2
Sheets("ora_text").Activate
Range("A1", Range("A1048570").End(xlUp)).ClearContents
Application.ScreenUpdating = True
Range("A1").Activate
MsgBox "Past Text (edit > past spacial > text ) The Data at 'A1' ", vbOKOnly + vbInformation
' prepair for copy data to sheet2
Sheets("ora_text").Activate
End Sub
Sub Process_Main()
Dim Branch As String
Dim CPC As String
Dim Acc_Code As String
Dim Sub_Acc As String
Dim Invoice_No As String
Dim Tran As String
Dim Cus_Name As String
Dim Cus_No As String
Dim GL_Date As String
Dim Debit_Amount1 As String
Dim Credit_Amount1 As String
Dim Debit_Amount2 As String
Dim Credit_Amount2 As String
Dim Description As String
Dim CFS As String
Dim r As Range
Dim i As Integer
Application.ScreenUpdating = False
Sheets("result1").Activate
Range("A2").Activate
Sheets("ora_text").Activate
For Each r In Range("A1", Range("A1048570").End(xlUp))
Sheets("ora_text").Activate
DoEvents
If Mid(r.Value, 1, 21) = "Accounting Flexfield:" Then
Branch = Trim(Mid(r.Value, 33, 6))
End If
If Mid(r.Value, 1, 21) = "Accounting Flexfield:" Then
CPC = Trim(Mid(r.Value, 40, 5))
End If
If Mid(r.Value, 1, 21) = "Accounting Flexfield:" Then
Acc_Code = Trim(Mid(r.Value, 46, 8))
End If
If Mid(r.Value, 1, 21) = "Accounting Flexfield:" Then
Sub_Acc = Trim(Mid(r.Value, 55, 6))
End If
If Mid(r.Value, 81, 1) = "-" And Mid(r.Value, 82, 1) <> "-" Then
Tran = Trim(Mid(r.Value, 17, 18))
Cus_Name = Trim(Mid(r.Value, 36, 25))
Cus_No = Trim(Mid(r.Value, 62, 16))
GL_Date = Trim(Mid(r.Value, 79, 9))
Debit_Amount1 = Trim(Mid(r.Value, 90, 19))
Credit_Amount1 = Trim(Mid(r.Value, 110, 19))
Debit_Amount2 = Trim(Mid(r.Value, 130, 19))
Credit_Amount2 = Trim(Mid(r.Value, 150, 19))
Description = Trim(Mid(r.Value, 170, 71))
CFS = Trim(Mid(r.Value, 242, 15))
Invoice_No = Trim(Mid(r.Value, 1, 15))
'check other line is empty for next name
For i = 1 To 1
If Mid(r.Offset(i, 0), 81, 1) <> "-" And Mid(r.Offset(i, 0), 1, 1) <> "" Then
Invoice_No = Invoice_No & Trim(Mid(r.Offset(i, 0), 1, 15))
Description = Description & Trim(Mid(r.Offset(i, 0), 170, 71))
Tran = Tran & Trim(Mid(r.Offset(i, 0), 17, 18))
Else
Exit For
End If
Next i
' ====
Sheets("result1").Activate
' ---
'ActiveCell.Value = invno
ActiveCell.Offset(0, 1 - 1).Value = Branch
ActiveCell.Offset(0, 2 - 1).Value = CPC
ActiveCell.Offset(0, 3 - 1).Value = Acc_Code
ActiveCell.Offset(0, 4 - 1).Value = Sub_Acc
ActiveCell.Offset(0, 5 - 1).Value = Tran
ActiveCell.Offset(0, 6 - 1).Value = Invoice_No
ActiveCell.Offset(0, 7 - 1).Value = Cus_No
ActiveCell.Offset(0, 8 - 1).Value = Cus_Name
ActiveCell.Offset(0, 9 - 1).Value = GL_Date
ActiveCell.Offset(0, 10 - 1).Value = Debit_Amount1
ActiveCell.Offset(0, 11 - 1).Value = Credit_Amount1
ActiveCell.Offset(0, 12 - 1).Value = Debit_Amount2
ActiveCell.Offset(0, 13 - 1).Value = Credit_Amount2
ActiveCell.Offset(0, 14 - 1).Value = Description
ActiveCell.Offset(0, 15 - 1).Value = CFS
' =========
Application.StatusBar = "Process : " + Cus_No
ActiveCell.Offset(1, 0).Activate
End If
Next
Sheets("result1").Activate
'ActiveCell.Value = "END"
'
Call Process_Step2
'
Sheets("Menu").Activate
Application.StatusBar = False
Application.ScreenUpdating = True
MsgBox "Process OK"
End Sub
Sub Process_Step2()
Sheets("result1").Activate
' text to column for Account Flexfield
Range("A2").Activate
Do While Len(ActiveCell.Value) <> 0 And Len(Trim(ActiveCell.Offset(0, 3).Value)) <> 0
If Len(Trim(ActiveCell.Value)) = 0 And Len(Trim(ActiveCell.Offset(0, 3).Value)) <> 0 Then
ActiveCell.Value = ActiveCell.Offset(-1, 0).Value
ActiveCell.Offset(0, 1).Value = ActiveCell.Offset(-1, 1).Value
End If
ActiveCell.Offset(1, 0).Activate
Loop
' end of text to column account Flefield
End Sub
