ดึงข้อมูลแยกชีท - VBA
Posted: Thu Dec 13, 2018 10:19 am
สวัสดีค่ะ
รายงานนี้ต้องการแยกข้อมูลแต่ละบริษัทตามชีทต่างๆ ยังติดปัญหาว่า เมื่อ run ข้อมูลกลับเจอรายการที่ไม่มีรหัสในฐานข้อมูลหลัก ถูกดึงมาวางทั้งหมดค่ะ เช่น รหัส 3000041 ไม่มี แต่โค้ดรันมาวางให้ทั้งหมดเลยค่ะ
ฐานข้อมูลหลักชื่อ "Control Sheet(New)" ฟิวด์ที่ Filter คือ AGENT_CODE อยู่คอลัมน์ 23
ขอคำแนะนำหน่อยค่ะ ต้องปรับแก้โค้ดที่ตรงไหนคะ ขอบคุณค่ะ
ที่่ module 1
ที่ module 2
รายงานนี้ต้องการแยกข้อมูลแต่ละบริษัทตามชีทต่างๆ ยังติดปัญหาว่า เมื่อ run ข้อมูลกลับเจอรายการที่ไม่มีรหัสในฐานข้อมูลหลัก ถูกดึงมาวางทั้งหมดค่ะ เช่น รหัส 3000041 ไม่มี แต่โค้ดรันมาวางให้ทั้งหมดเลยค่ะ
ฐานข้อมูลหลักชื่อ "Control Sheet(New)" ฟิวด์ที่ Filter คือ AGENT_CODE อยู่คอลัมน์ 23
ขอคำแนะนำหน่อยค่ะ ต้องปรับแก้โค้ดที่ตรงไหนคะ ขอบคุณค่ะ
ที่่ module 1
Code: Select all
Sub myLedger()
Dim lastRow As Long, i As Long, erow As Long
lastRow = Sheets("Control Sheet(New)").Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To lastRow
If Sheets("Control Sheet(New)").Cells(i, 23) = "3000038" Then
Sheets("Control Sheet(New)").Range(Cells(i, 1), Cells(i, 34)).Select
Selection.Copy
'Sheets.Open ("Control Sheet(New)")
Sheets("3000038").Select
lastRow = Sheets("3000038").Range("A" & Rows.Count).End(xlUp).Row
erow = lastRow + 1
ActiveSheet.Cells(erow, 1).Select
ActiveSheet.Paste
ActiveWorkbook.Save
Application.CutCopyMode = False
End If
Sheets("Control Sheet(New)").Select
Next i
End Subที่ module 2
Code: Select all
Sub filterData()
Dim myvalue As String
myvalue = InputBox("Enter the item you wish to extract")
Sheets(myvalue).Select
Sheets(myvalue).Cells.Clear
Range("A1") = "SUBMISSION_BATCH_NO"
Range("B1") = "POLICY_NO"
Range("C1") = "COMPANY_NAME"
Range("D1") = "NAME"
Range("E1") = "INCIDENT_DATE"
Range("F1") = "INCIDENT_TIME"
Range("G1") = "ADMIT_DATE"
Range("H1") = "DISCHARGE_DATE"
Range("I1") = "HOSPITAL_NAME"
Range("J1") = "ICD10"
Range("K1") = "COVERAGE_TYPE"
Range("L1") = "BILL_AMOUNT"
Range("M1") = "APPROVED_AMOUNT"
Range("N1") = "EXCESS_AMOUNT"
Range("O1") = "CLAIM_STATUS"
Range("P1") = "DECISION_DATE"
Range("Q1") = "PAYMENT_DATE"
Range("R1") = "DECLINE_REJECT_REASON"
Range("S1") = "CHANNEL_NAME"
Range("T1") = "PAYMENT_METHOD"
Range("U1") = "EMPLOYEE_CODE"
Range("V1") = "PLAN_CODE"
Range("W1") = "AGENT_CODE"
Range("X1") = "FULLNAME"
Range("Y1") = "PARENT_CODE"
Range("Z1") = "PARENT_NAME"
Range("AA1") = "UNIT_CODE"
Range("AB1") = "UNIT_NAME"
Range("AC1") = "OFFICE_CODE"
Range("AD1") = "OFFICE_NAME"
Range("AE1") = "DOCUMENT_CHANNEL"
Range("AF1") = "GOV_INSURANCE_FLAG"
Range("AG1") = "REMARK_CUSTOMER"
Range("AH1") = "ESUBMISSION_NO"
Range("A1:AH1").Font.Bold = True
Range("A1:AH1").Font.ColorIndex = 5
Sheets("Control Sheet(New)").Select
Dim lastRow As Long
lastRow = Sheets("Control Sheet(New)").Cells.Find(What:="*", _
After:=Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
Dim lastColumn As Long
lastColumn = Sheets("Control Sheet(New)").Cells.Find(What:="*", _
After:=Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
Sheets("Control Sheet(New)").Range(Cells(1, 1), Cells(lastRow, lastColumn)).AutoFilter Field:=23, Criteria1:=myvalue
Sheets("Control Sheet(New)").Range(Cells(2, 1), Cells(lastRow, lastColumn)).Copy
Sheets(myvalue).Select
erow = Sheets(myvalue).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Sheets(myvalue).Paste Destination:=Worksheets(myvalue).Rows(erow)
Sheets("Control Sheet(New)").Select
Sheets("Control Sheet(New)").Range(Cells(1, 1), Cells(lastRow, lastColumn)).AutoFilter Field:=23
ActiveWorkbook.Save
End Sub