snasui wrote:ลองเขียนมาก่อนดีไหมครับ
ดีครับ...
สวัสดีครับอาจารย์หวังว่าอาจารย์คงยังอยู่
จาก Cod คำสั่ง
snasui wrote:Next
Worksheets("Sheet2").Range("B1").EntireColumn.Delete
Application.ScreenUpdating = True
มันทำให้ข้อมูลที่อยู่ด้านหลังหมายถึงสูตรอื่นที่ผมเขียนไว้ ขยับ เช่นเคยอยูที่ F4 ก็เลื่อนมาเป็น E4
หากตัดคำสั่ง
Code: Select all
Worksheets("Sheet2").Range("B1").EntireColumn.Delete
จะมีผลต่อข้อมูลตามคำสั่งที่อาจารย์ให้มาไหมครับ
2.อย่างที่ได้แจ้งให้ทราบก่อนหน้านี้ว่าข้อมูลที่นำมาแปลงเป็นข้อมูลที่นำเข้ามา ผมต้องนำ
คำสั่งของอาจารย์มารวม เพราะต้องการให้การนำเข้าและจัดการข้อมูลเสร็จในครั้งเดียว
หากมีหลายปุ่มคำสั่งเกรงผู้ใช้จะงง
lonex.jpg
Code: Select all
Private Sub CommandButton28_Click()
Dim fileToOpen
Dim rs As Range, rt As Range, ri As Range
Dim lng As Long, lngLr As Long
Sheet10.Range("A:D").Value = ""
Application.ScreenUpdating = False
Sheet22.Activate
Sheet22.Range("A1:AP1").Value = Sheet15.Range("A200:AP200").Value
ChDir "C:\swbpr\data\datafdu"
fileToOpen = Application.GetOpenFilename("FILEC ·Õèä´é¨Ò¡ BPR->PALM,")
If fileToOpen = False Then
MsgBox "Please select file."
Exit Sub
End If
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & fileToOpen, Destination:=Range("$A$2"))
.Name = "FILEC."
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 874
.TextFileStartRow = 1
.TextFileParseType = xlFixedWidth
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileFixedColumnWidths = Array(8, 1, 2, 2, 7, 2, 2, 2, 2, 7, 2, 2, 2, 2, 7, 2, 2, 2, 2, 7, _
2, 2, 2, 2, 7, 2, 2, 2, 2, 7, 2, 2, 2, 2, 7, 2, 2, 2, 2, 7, 2)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=True
End With
Columns("F:G").Select
Selection.Delete Shift:=xlToLeft
Columns("I:J").Select
Selection.Delete Shift:=xlToLeft
Columns("L:M").Select
Selection.Delete Shift:=xlToLeft
Columns("O:P").Select
Selection.Delete Shift:=xlToLeft
Columns("R:S").Select
Selection.Delete Shift:=xlToLeft
Columns("U:V").Select
Selection.Delete Shift:=xlToLeft
Columns("X:Y").Select
Selection.Delete Shift:=xlToLeft
Columns("AA:AB").Select
Selection.Delete Shift:=xlToLeft
ActiveSheet.QueryTables(1).Delete
Application.ScreenUpdating = False
lngLr = Rows.Count
Worksheets("DataC").Range("A1:E1").Copy Worksheets("FileC").Range("A1")
With Worksheets("DataC")
Set rs = .Range("A2", .Range("B2").End(xlDown))
End With
For lng = 1 To 8
Set rt = Worksheets("FileC").Range("A" & lngLr).End(xlUp).Offset(1, 0)
rs.Copy: rt.PasteSpecial xlPasteValues
Next lng
Set rs = rs.Offset(0, 2).Resize(, 3)
For lng = 1 To 8
Set rt = Worksheets("FileC").Range("C" & lngLr).End(xlUp).Offset(1, 0)
rs.Copy: rt.PasteSpecial xlPasteValues
Set rs = rs.Offset(0, 3)
Next
Worksheets("FileC").Range("B1").EntireColumn.Delete'ทำให้Colummเลื่อน แก้เป็นApplication.CutCopyMode = False
Sheet22.Range("A:Z").ClearContents
Application.ScreenUpdating = True
'With Workbooks("DumP.xlsm").Worksheets("FileC") 'สั่งกรองข้อมูลเพื่อลบข้อมูลที่เป็น 0
'Set ri = .Range(.Range("A2"), .Range("D65536") _
'.End(xlUp)).SpecialCells(xlCellTypeVisible)
'End With
'Sheet10.Activate
'Sheet10.Range("A:D").AutoFilter Field:=2, Criteria1:="0"
'Sheet10.Range("A:D").AutoFilter Field:=3, Criteria1:="0"
'Sheet10.Range("A:D").AutoFilter Field:=4, Criteria1:="0"
'ri.Select
'ri.Value = ""
'Sheet10.ShowAllData
'Sheets("FileC").Activate
'Sheet10.Columns("A:D").Select
'ActiveWorkbook.Worksheets("FileC").Sort.SortFields.Clear
'ActiveWorkbook.Worksheets("FileC").Sort.SortFields.Add key:=Range("A1"), _
'SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
'With ActiveWorkbook.Worksheets("FileC").Sort
'.SetRange Range("A2:D65633")
'.Header = xlNo
' .MatchCase = False
' .Orientation = xlTopToBottom
' .SortMethod = xlPinYin
'.Apply
'End With
'Sheet22.Activate
'Sheet22.Range("A:Z").Delete
'Workbooks("DumP.xlsm").Save
End Sub
หลังจากที่ได้ข้อมูลมาก็ใช้คำสั่งต่อไปนี้เพื่อสร้าง FilceC ให้สมบูรณ์
Code: Select all
Private Sub CommandButton5_Click()
Dim r As Integer
If Sheet10.Range("F2").Value <> "" Then
Exit Sub
End If
With Workbooks("DumP.xlsm").Worksheets("FileC")
Application.ScreenUpdating = False
Sheets("FileC").Activate
Label18.Caption = "กำลังรวบรวมข้อมูล FileC %"
Sheet10.Range("W1").Value = "เขต"
Sheet10.Range("F1").Value = "เลขทะเบียน"
Sheet10.Range("G1").Value = "ชื่อ-สกุล"
Sheet10.Range("H1").Value = "ที่อยู่"
Sheet10.Range("I1").Value = "รหัสโครงการ"
r = 2
Do Until Sheet10.Cells(r, 1).Value = ""
Sheet10.Cells(r, 6).Formula = "=VLOOKUP(" & Sheet10.Cells(r, 1).Address & ",FileB!A:T,3,0)"
Sheet10.Cells(r, 7).Formula = "=VLOOKUP(" & Sheet10.Cells(r, 6).Address & ",FileA!A:G,5,0)"
Sheet10.Cells(r, 8).Formula = "=VLOOKUP(" & Sheet10.Cells(r, 6).Address & ",FileA!A:G,7,0)"
Sheet10.Cells(r, 9).Formula = "=VLOOKUP(" & Sheet10.Cells(r, 1).Address & ",FileB!A:T,17,0)"
Sheet10.Cells(r, 23).Formula = "=VLOOKUP(" & Sheet10.Cells(r, 6).Address & ",FileA!A:G,3,0)"
TextBox7.Value = Sheet10.Range("P1").Value
DoEvents
r = r + 1
Loop
Sheet10.Range("J:J").Value = Sheet10.Range("F:F").Value
Sheet10.Range("K:K") = Sheet10.Range("G:G").Value
Sheet10.Range("L:L") = Sheet10.Range("H:H").Value
Sheet10.Range("M:M") = Sheet10.Range("I:I").Value
Sheet10.Range("E:E") = Sheet10.Range("W:W").Value
Sheet10.Range("F:I").Value = Sheet10.Range("J:M").Value
Sheet10.Range("J:M").ClearContents
Sheet10.Range("W:W").ClearContents
Label18.Caption = "ข้อมูล FileC สมบูรณ์ " & Now()
MsgBox "รวบรวมข้อมูล FileC สมบูรณ์" , vbOKOnly, "DumP"
Sheet10.Range("S1").Value = Label18.Caption
End With
Application.ScreenUpdating = True
Workbooks("DumP.xlsm").Save
End Sub
เกิดปัญหาครับ เลขที่สัญญาที่ได้จากการนำเข้าและจัดเรียงตามคำสั่งแรกไม่สามารถ VLookup ได้ครับ
จากการหาสาเหตุ ผมคิดว่ามันมีรูปแบบเป็นText หรือเป็น ตัวเลข แต่ก็ไม่ใช่
ต้องเอาเมาส์ไปคลิ๊กที่เลขที่สัญญา แล้วKEy *1 ค่าในเซลนั้นแสดงผลเป็น *1 มันก็Vlookup เจอทันที
A2 = 40014235
E2=VLOOKUP(A2,FileB!A:T,3,0) ค่าที่ได้ #N/A
แต่พอ เลือก A2 แล้วพิมพ์ *1 ปรากฎว่าที่ E2 ก็แสดงค่าตามต้องการ
งงครับ ช่วยด้วยครับ
You do not have the required permissions to view the files attached to this post.
สมาชิกท่านใดที่ยังไม่ได้ระบุ Version ของ Excel ที่ใช้งานจริง สามารถทำตาม Link นี้เพื่อจะได้รับคำตอบที่ตรงกับ Version ของท่านครับ 
โปรดทราบ 
อาจารย์ครับจาก code ที่เขียนมา
เอ่อ...