EXCEL TOOLS
Excel Add-ins ที่พัฒนาโดยคุณสันติพงศ์ ณสุย (MVP Excel 2010-2020) ด้วยภาษา C# เพื่อแก้ไขปัญหาไฟล์ใหญ่ คำนวณนาน ทำงานช้า จัดการข้อมูลต่าง ๆ ที่ทำงานประจำวันได้อย่างสะดวกรวดเร็ว สนใจคลิกไปดูได้ที่นี่ครับ => Excel Tools
Excel Add-ins ที่พัฒนาโดยคุณสันติพงศ์ ณสุย (MVP Excel 2010-2020) ด้วยภาษา C# เพื่อแก้ไขปัญหาไฟล์ใหญ่ คำนวณนาน ทำงานช้า จัดการข้อมูลต่าง ๆ ที่ทำงานประจำวันได้อย่างสะดวกรวดเร็ว สนใจคลิกไปดูได้ที่นี่ครับ => Excel Tools
[code]
และปิดด้วย [/code]
ตัวอย่างเช่น [code]dim r as range[/code]
เพื่อให้แตกต่างจากข้อความทั่วไป สะดวกในการอ่านและทดสอบ (คลิกเพื่อดูตัวอย่าง)Code: Select all
Sub PD()
Sheets("PD").Activate
Application.Goto Reference:="OFFSET(R2C1,0,4,1,1)"
Selection.Copy
Sheets("Data").Select
'Sheets("Sheet1").Select
'Sheets("PD").Activate
Application.Goto Reference:= _
"OFFSET('[Test.xlsm]Data'!R2C1,MATCH(R2C1,INDEX('[Test.xlsm]Data'!R2C1:R50000C1,0),0),4)"
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
Code: Select all
Sub PD()
Dim firstID As String
Sheets("PD").Activate
Application.Goto Reference:="OFFSET(R2C1,,,,6)"
Selection.Copy
Sheets("Data").Select
firstID = Range("A2").Value
If firstID = """" Then Application.Goto Reference:="R2C1"
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Else
Application.Goto Reference:="R1C1"
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
จากcodeที่ให้มา คือ copy ทั้งแถว ไปต่อท้ายข้อมูล ซึ่งไม่ตรงกับความต้องการครับparakorn wrote: Thu Nov 07, 2019 3:29 pm ตัวอย่างโค้ดครับ
Code: Select all
Sub PD() Dim firstID As String Sheets("PD").Activate Application.Goto Reference:="OFFSET(R2C1,,,,6)" Selection.Copy Sheets("Data").Select firstID = Range("A2").Value If firstID = """" Then Application.Goto Reference:="R2C1" Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Else Application.Goto Reference:="R1C1" Selection.End(xlDown).Select ActiveCell.Offset(1, 0).Range("A1").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False End Sub
Code: Select all
Sub PD()
Sheets("PD").Activate
Application.Goto Reference:="OFFSET(R2C1,0,4,1,1)"
Selection.Copy
Sheets("Data").Select
Application.Goto Reference:= _
"INDEX(Data!R2C1:R11C6,LARGE(IF(Data!R2C1:R11C1=PD!R2C1,ROW(Data!R2C1:R11C1)-ROW(Data!R1C1)),1),5)"
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
Code: Select all
Sub PD()
ThisWorkbook.Activate
Sheets("PD").Activate
Application.Goto Reference:="OFFSET(R2C1,0,4,1,1)"
Selection.Copy
Workbooks("Data.xlsx").Activate
Sheets("Data").Select
Application.Goto Reference:= _
"INDEX('[Data.xlsx]Data'!R2C1:R5000C9,LARGE(IF('[Data.xlsx]Data'!R2C1:R5000C1=PD!R2C1,ROW('[Data.xlsx]Data'!R2C1:R5000C1)-ROW('[Data.xlsx]Data'!R1C1)),1),5)"
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
Code: Select all
Dim i As Long
Dim r As Range, rTgAll As Range
Set r = ThisWorkbook.Worksheets("PD").Range("a2")
With Workbooks("Data.xlsx").Worksheets("Data")
Set rTgAll = .Range("a2", .Range("a" & .Rows.Count).End(xlUp))
For i = rTgAll.Count To 1 Step -1
If rTgAll(i).Value = r.Value Then
rTgAll(i).Offset(0, 4).Value = r.Offset(0, 4).Value
Exit For
End If
Next i
End With
กรุณาถามเฉพาะที่ไม่เข้าใจ ผมขออภัยที่ไม่แปล Code รายบรรท้ดครับsakajohn wrote: Fri Nov 08, 2019 10:12 am รบกวนผู้รู้ช่วยอธิบายสูตรด้วยครับ เพื่อจะได้นำไปต่อยอดได้ครับ
If rTgAll(i).Value = r.Value Then
โดยเพิ่มเงื่อนไขการตรวจสอบว่าต้องเป็นเครื่องพิมพ์เดียวกันเข้าไปอีก 1 เงื่อนไข ลองพยายามปรับมาเองก่อน ติดตรงไหนค่อยถามกันต่อครับIf rTgAll(i).Value = r.Value And Your New Condition Then