:D snasui.com ยินดีต้อนรับ :D
ยินดีต้อนรับสู่กระดานถามตอบ Excel and VBA และอื่น ๆ ที่เป็นมิตรกับทุกท่าน มีไฟล์แนบมหาศาล ช่วยให้ท่านค้นหาและติดตามศึกษาได้โดยง่าย :thup: สมาชิกท่านใดที่ยังไม่ได้ระบุ Version ของ Excel ที่ใช้งานจริง สามารถทำตาม Link นี้เพื่อจะได้รับคำตอบที่ตรงกับ Version ของท่านครับ :arrow: ระบุ Version ของ Excel
:!: โปรดทราบ :!:
  1. กรุณาอ่านกฎการใช้บอร์ด (Forum rules) ในตำแหน่งด้านบนของแต่ละบอร์ด
  2. การสมัครสมาชิก การ Login การกู้คืนรหัสผ่าน
    1. สมัครสมาชิกดูขั้นตอนได้ที่ :arrow: สมัครสมาชิก
    2. Login เข้าระบบโดยคลิกปุ่ม Login ตรงมุมขวาบนของหน้านี้ :roll:
    3. การ Login ผ่าน Facebook ดูวิธีที่ :arrow: Login ผ่าน Facebook
    4. ลืมรหัสผ่านสามารถรับรหัสใหม่ได้ที่ :arrow: Reset รหัสผ่าน
  3. มีปัญหาการใช้งาน แจ้งผู้ดูแลระบบได้ที่ :arrow: ติดต่อผู้ดูแลระบบ
  4. กำหนดการตั้งค่าส่วนตัว เช่นตั้งค่าภาษาเป็นไทยหรืออังกฤษดูได้ที่ :arrow: ตั้งค่าส่วนตัว
  5. การตั้งและตอบกระทู้ดูได้ที่ :arrow: วิธีการตั้งและตอบกระทู้
  6. การจัดรูปแบบตัวอักษรด้วย bbcode ในช่องแสดงความคิดเห็นดูได้ที่ :arrow: จัดรูปแบบตัวอักษร
  7. กำหนดขนาดตัวอักษรใน Browser ดูได้ที่ :arrow: กำหนดขนาดตัวอักษรใน Browser

สอบถามสูตรการ วนLoop นำข้อมูลไปบันทึก

ฟอรัมถาม-ตอบปัญหาการใช้งานสูตรและฟังก์ชัน Excel
Forum rules
  1. ไม่อนุญาตให้ใช้ภาษาแชทในการถามและตอบปัญหา ไม่ใช้คำว่า "คับ" หรือ "อ่ะครับ" แทนคำว่า "ครับ" ไม่ใช้คำว่า "เด๋ว" แทนคำว่า "เดี๋ยว" เป็นต้น เนื่องจากเมื่อแปลเป็นภาษาต่างประเทศแล้วจะให้ความหมายผิดไปจากที่ควรจะเป็น
  2. ห้ามถามโดยระบุชื่อผู้ตอบและต้องตั้งชื่อกระทู้ให้สื่อถึงปัญหาที่จะถาม ไม่ตั้งชื่อว่า ช่วยด้วยครับ, มีปัญหามาปรึกษาครับ เป็นต้น
  3. กรุณาอธิบายปัญหาและระบุคำตอบที่ต้องการมาในกระทู้ด้วยเสมอถึงแม้จะอธิบายไว้ในไฟล์แนบแล้วก็ตาม ทั้งนี้เพื่ออำนวยความสะดวกแก่เพื่อนสมาชิกในการค้นหาข้อมูล
  4. กรุณาแนบไฟล์ตัวอย่างพร้อมแสดงคำตอบที่ถูกต้องมาในไฟล์ด้วยเพื่อให้ง่ายต่อการทำความเข้าใจและสะดวกต่อการตอบคำถาม (ขนาดไฟล์ไม่เกิน 500Kb ขนาดภาพไม่เกิน 800*600 Pixel) ไม่แนบเป็น Link มาจากแหล่งอื่นที่อาจจะถูกลบทิ้งไปโดยต้นทางในภายหลัง นอกจากนี้ไม่ควรแนบไฟล์ที่มีข้อมูลสำคัญอันก่อให้เกิดความเสียหายกับตนเองและผู้อื่น
  5. กรณีเป็นคำถามเกี่ยวกับ Programming เช่น VBA, VB.Net, C#, SQL ฯลฯ ต้องลองเขียนมาเองก่อนเสมอ ถามเฉพาะที่ติดปัญหา ระบุ Module, Procedure ที่ติดปัญหาให้ชัดเจน กรุณาโพสต์ Code ให้แสดงเป็น Code คือเปิดด้วย [code] และปิดด้วย [/code] ตัวอย่างเช่น [code]dim r as range[/code] เพื่อให้แตกต่างจากข้อความทั่วไป สะดวกในการอ่านและทดสอบ (คลิกเพื่อดูตัวอย่าง)
  6. กรุณาแจ้งผลการใช้งานเมื่อได้รับคำตอบว่าตรงกับความต้องการหรือไม่
Post Reply
sakajohn
Member
Member
Posts: 229
Joined: Tue Aug 06, 2013 10:55 am
Excel Ver: 2010

สอบถามสูตรการ วนLoop นำข้อมูลไปบันทึก

#1

Post by sakajohn »

รบกวนสอบถามครับ ผมต้องการนำข้อมูล จากบรรทัด AH6 ถึง AH41 ไปบันทึกในอีกไฟล์งาน แต่เดิมผมมีข้อมูลแค่ AH6 ถึง AH 20 ตอนนี้ผมใช้Code

Code: Select all

           
Workbooks("DataBase.xlsx").Save
ThisWorkbook.Activate
    If Range("AH6").Value <> "" Then
    Application.Goto Reference:="OFFSET(R6C34,0,5,1,5)"
       Selection.Copy
    'Workbooks.Open Filename:="\\ACCOUNT\Data (D)\SALE\DataBase.xlsx"
  ThisWorkbook.Activate
    Application.Goto Reference:= _
        "OFFSET('[DataBase.xlsx]Sheet1'!R1C1,MATCH(R6C34,INDEX('[DataBase.xlsx]Sheet1'!R2C1:R50000C1,0),0),37)"
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
   End If
      ThisWorkbook.Activate
       If Range("AH7").Value <> "" Then
      .
      .
      .
      .
      .
        ThisWorkbook.Activate
 If Range("AH20").Value <> "" Then
     Application.Goto Reference:="OFFSET(R7C34,0,5,1,5)"
    Selection.Copy   
    Application.Goto Reference:= _
        "OFFSET('[DataBase.xlsx]Sheet1'!R1C1,MATCH(R7C34,INDEX('[DataBase.xlsx]Sheet1'!R2C1:R50000C1,0),0),37)"
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
   End If
   .
   .
   .
    End If
ตอนนี้ติดปัญหาคือ ถ้ามีการเพิ่มข้อมูล ผมจะต้องเขียนCode อีกหลายบรรทัด เลยอยากขอคำแนะนำว่ามีวิธีเขียนCodeแบบอื่นไหมที่สะดวกว่านี้ครับ
Top
User avatar
puriwutpokin
Guru
Guru
Posts: 3801
Joined: Fri Jan 04, 2013 9:49 pm
Location: Bangkok
Excel Ver: MS.365

Re: สอบถามสูตรการ วนLoop นำข้อมูลไปบันทึก

#2

Post by puriwutpokin »

ควรแบบไฟล์ตัวอย่างที่ต้องการขยายไป อย่างไร พร้อมกับโค้ดมาในไฟล์นั้นๆด้วย ครับจะได้ตอบได้ตรงประเด็นครับ
:shock: :roll: :D
Top
sakajohn
Member
Member
Posts: 229
Joined: Tue Aug 06, 2013 10:55 am
Excel Ver: 2010

Re: สอบถามสูตรการ วนLoop นำข้อมูลไปบันทึก

#3

Post by sakajohn »

ไฟล์ 900 kb ทำไมฟ้องว่าใหญ่เกินไปไม่สามารถ Add fileได้ครับ พยายามตัดที่ไม่จำเป็นออกหมดแล้วครับ
Top
sakajohn
Member
Member
Posts: 229
Joined: Tue Aug 06, 2013 10:55 am
Excel Ver: 2010

Re: สอบถามสูตรการ วนLoop นำข้อมูลไปบันทึก

#4

Post by sakajohn »

มีวิธีแนบไฟล์แบบไหนได้บ้างครับ ตอนนี้ลบจนไม่เหลือข้อมูลยัง 900 kb อยู่เลยครับ เกี่ยวกับcode ที่เขียนยาวไปไหมครับ ถึงทำให้ไฟล์มีขนาดใหญ่
Top
sakajohn
Member
Member
Posts: 229
Joined: Tue Aug 06, 2013 10:55 am
Excel Ver: 2010

Re: สอบถามสูตรการ วนLoop นำข้อมูลไปบันทึก

#5

Post by sakajohn »

ได้แล้วครับ save เป็นไฟล์ xlbs
You do not have the required permissions to view the files attached to this post.
Top
User avatar
puriwutpokin
Guru
Guru
Posts: 3801
Joined: Fri Jan 04, 2013 9:49 pm
Location: Bangkok
Excel Ver: MS.365

Re: สอบถามสูตรการ วนLoop นำข้อมูลไปบันทึก

#6

Post by puriwutpokin »

ตัวอย่างโค้ดครับ ปรับในส่วนนี้ดูครับ แล้วตัดตัวอื่นๆ ออกไม่จำเป็นครับ

Code: Select all

Sub Macro5()
Dim r, rAll As Range
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'Workbooks("DataPlan.xlsx").Save
Set rg = Range("AH6")
rg.Activate
If Application.CountA(Range("AH6")) = 0 Then
    MsgBox "ไม่มีข้อมูลให้บันทึก"
    Application.Calculation = xlCalculationAutomatic
    Exit Sub
End If
Set rg = Range("Q3")
rg.Activate
If Application.CountA(Range("S3")) = 0 Then
    MsgBox "ใส่วันที่ผลิตงานด้วย"
  Application.Calculation = xlCalculationAutomatic
    Exit Sub
End If
MsgBox ("อย่าลืมเปลี่ยนกระดาษนะครับ"), vbCritical
ActiveSheet.Unprotect Password:="1234"
Workbooks("DataBase.xlsx").Saved = False
ThisWorkbook.Activate
Set rAll = Range("AH6:AH" & Range("AH" & Rows.Count).End(xlUp).row)
 For Each r In rAll
    If r.Value <> "" Then
     r.Offset(0, 5).Resize(1, 5).Copy
    'Workbooks.Open Filename:="\\ACCOUNT\Data (D)\SALE\DataBase.xlsx"
  ThisWorkbook.Activate
    Application.Goto Reference:= _
        "OFFSET('[DataBase.xlsx]Sheet1'!R1C1,MATCH(R6C34,INDEX('[DataBase.xlsx]Sheet1'!R2C1:R50000C1,0),0),37)"
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False

    'ActiveWorkbook.Save
    'ActiveWorkbook.Close

   End If
    'Other Code...
     Next r
:shock: :roll: :D
Top
sakajohn
Member
Member
Posts: 229
Joined: Tue Aug 06, 2013 10:55 am
Excel Ver: 2010

Re: สอบถามสูตรการ วนLoop นำข้อมูลไปบันทึก

#7

Post by sakajohn »

รบกวนสอบถามครับ Next r จะต้องไปวางไว้ตรงส่วนไหนครับ

Code: Select all

Dim r, rAll As Range
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

'Workbooks("DataPlan.xlsx").Save
Set rg = Range("AH6")
rg.Activate
If Application.CountA(Range("AH6")) = 0 Then
    MsgBox "äÁèÁÕ¢éÍÁÙÅãËéºÑ¹·Ö¡"
    Application.Calculation = xlCalculationAutomatic
    Exit Sub
End If
Set rg = Range("Q3")
rg.Activate
If Application.CountA(Range("S3")) = 0 Then
    MsgBox "ãÊèÇѹ·Õè¼ÅÔµ§Ò¹´éÇÂ"
  Application.Calculation = xlCalculationAutomatic
    Exit Sub
End If
MsgBox ("ÍÂèÒÅ×Áà»ÅÕ蹡ÃдÒɹФÃѺ"), vbCritical
ActiveSheet.Unprotect Password:="1234"

    
            
Workbooks("DataBase.xlsx").Saved = False
ThisWorkbook.Activate
Set rAll = Range("AH6:AH" & Range("AH" & Rows.Count).End(xlUp).row)
 For Each r In rAll
    If r.Value <> "" Then
     r.Offset(0, 5).Resize(1, 5).Copy
    'Workbooks.Open Filename:="\\ACCOUNT\Data (D)\SALE\DataBase.xlsx"
  ThisWorkbook.Activate
    Application.Goto Reference:= _
        "OFFSET('[DataBase.xlsx]Sheet1'!R1C1,MATCH(R6C34,INDEX('[DataBase.xlsx]Sheet1'!R2C1:R50000C1,0),0),37)"
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False

    'ActiveWorkbook.Save
    'ActiveWorkbook.Close

   End If
    'ตรงส่วนนี้คือบันทึกใน ไฟล์ชื่อ Database โดยต้องไล่จนครบ แล้วจึงไปทำคำสั่งต่อไป
 '----------------------------------------------------------------------------------------------------------------------------------------------------
 
    ThisWorkbook.Activate
    'next r
 'คำสั่งช่วงนี้คือ บันทึกใน ไฟล์ชื่อ DataPlan โดยต้องไล่จนครบ แล้วจึงไปทำคำสั่งต่อไป
    Workbooks("Dataplan.xlsx").Save
    If Range("AH6").Value <> "" Then
   'ActiveSheet.Unprotect Password:="1234"
    Application.Goto Reference:="OFFSET(R6C34,0,4,1,10)"
       Selection.Copy
  ThisWorkbook.Activate
    Application.Goto Reference:= _
        "OFFSET('[DataPlan.xlsx]Sheet1'!R1C1,MATCH(R6C34,INDEX('[DataPlan.xlsx]Sheet1'!R2C1:R50000C1,0),0),25)"
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False

    'ActiveWorkbook.Save
    'ActiveWorkbook.Close

   End If
        ThisWorkbook.Activate
        Next r
การทำงานคือ ต้องการ copy ข้อมูลจากไฟล์ daily1 sheet M01 ไปวางที่ไฟล์ Database โดยดูรหัสcodeที่ colume AH ต้องตรงกันจึงนำค่าไปวาง จนครบตามจำนวนค่าที่มีทั้งหมด จากนั้นจึงcopy ข้อมูล โดยจะนำไปวางที่ไฟล์ DataPlan โดยใช้หลักการเดียวกัน ตอนนี้ที่ เขียนว่า Other Code... แล้วตามด้วย Next r มันนำค่าไปวางที่ไฟล์ DataBaseแค่รายการเดียว จากนั้นก็ Copy แล้วไปวางที่ DataPlan ต่อเลยครับ
พอผมลองเอา Next r ไปวางต่อคำสั่ง DataBase มันจะ Copy รายการแรกไปวางที่ DataBase ได้ถูกต้อง จากนั้นก็มา Copy ต่อที่รายการที่ 2 แต่มันเอาไปวางทับข้อมูลที่วางอันแรกในไฟล์ DataBase ครับ ไม่ได้วางตามรหัสตรงกันครับ จากนั้น ก็ วน ไม่ไปไหนเลยครับ ทั้งที่ข้อมูลก็หมดแล้วครับ
Top
sakajohn
Member
Member
Posts: 229
Joined: Tue Aug 06, 2013 10:55 am
Excel Ver: 2010

Re: สอบถามสูตรการ วนLoop นำข้อมูลไปบันทึก

#8

Post by sakajohn »

รบกวนสอบถามครับ Next r จะต้องไปวางไว้ตรงส่วนไหนครับ

Code: Select all

Dim r, rAll As Range
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

'Workbooks("DataPlan.xlsx").Save
Set rg = Range("AH6")
rg.Activate
If Application.CountA(Range("AH6")) = 0 Then
    MsgBox "äÁèÁÕ¢éÍÁÙÅãËéºÑ¹·Ö¡"
    Application.Calculation = xlCalculationAutomatic
    Exit Sub
End If
Set rg = Range("Q3")
rg.Activate
If Application.CountA(Range("S3")) = 0 Then
    MsgBox "ãÊèÇѹ·Õè¼ÅÔµ§Ò¹´éÇÂ"
  Application.Calculation = xlCalculationAutomatic
    Exit Sub
End If
MsgBox ("ÍÂèÒÅ×Áà»ÅÕ蹡ÃдÒɹФÃѺ"), vbCritical
ActiveSheet.Unprotect Password:="1234"

    
            
Workbooks("DataBase.xlsx").Saved = False
ThisWorkbook.Activate
Set rAll = Range("AH6:AH" & Range("AH" & Rows.Count).End(xlUp).row)
 For Each r In rAll
    If r.Value <> "" Then
     r.Offset(0, 5).Resize(1, 5).Copy
    'Workbooks.Open Filename:="\\ACCOUNT\Data (D)\SALE\DataBase.xlsx"
  ThisWorkbook.Activate
    Application.Goto Reference:= _
        "OFFSET('[DataBase.xlsx]Sheet1'!R1C1,MATCH(R6C34,INDEX('[DataBase.xlsx]Sheet1'!R2C1:R50000C1,0),0),37)"
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False

    'ActiveWorkbook.Save
    'ActiveWorkbook.Close

   End If
    'ตรงส่วนนี้คือบันทึกใน ไฟล์ชื่อ Database โดยต้องไล่จนครบ แล้วจึงไปทำคำสั่งต่อไป
 '----------------------------------------------------------------------------------------------------------------------------------------------------
 
    ThisWorkbook.Activate
    'next r
 'คำสั่งช่วงนี้คือ บันทึกใน ไฟล์ชื่อ DataPlan โดยต้องไล่จนครบ แล้วจึงไปทำคำสั่งต่อไป
    Workbooks("Dataplan.xlsx").Save
    If Range("AH6").Value <> "" Then
   'ActiveSheet.Unprotect Password:="1234"
    Application.Goto Reference:="OFFSET(R6C34,0,4,1,10)"
       Selection.Copy
  ThisWorkbook.Activate
    Application.Goto Reference:= _
        "OFFSET('[DataPlan.xlsx]Sheet1'!R1C1,MATCH(R6C34,INDEX('[DataPlan.xlsx]Sheet1'!R2C1:R50000C1,0),0),25)"
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False

    'ActiveWorkbook.Save
    'ActiveWorkbook.Close

   End If
        ThisWorkbook.Activate
        Next r
การทำงานคือ ต้องการ copy ข้อมูลจากไฟล์ daily1 sheet M01 ไปวางที่ไฟล์ Database โดยดูรหัสcodeที่ colume AH ต้องตรงกันจึงนำค่าไปวาง จนครบตามจำนวนค่าที่มีทั้งหมด จากนั้นจึงcopy ข้อมูล โดยจะนำไปวางที่ไฟล์ DataPlan โดยใช้หลักการเดียวกัน ตอนนี้ที่ เขียนว่า Other Code... แล้วตามด้วย Next r มันนำค่าไปวางที่ไฟล์ DataBaseแค่รายการเดียว จากนั้นก็ Copy แล้วไปวางที่ DataPlan ต่อเลยครับ
พอผมลองเอา Next r ไปวางต่อคำสั่ง DataBase มันจะ Copy รายการแรกไปวางที่ DataBase ได้ถูกต้อง จากนั้นก็มา Copy ต่อที่รายการที่ 2 แต่มันเอาไปวางทับข้อมูลที่วางอันแรกในไฟล์ DataBase ครับ ไม่ได้วางตามรหัสตรงกันครับ จากนั้น ก็ วน ไม่ไปไหนเลยครับ ทั้งที่ข้อมูลก็หมดแล้วครับ
Top
sakajohn
Member
Member
Posts: 229
Joined: Tue Aug 06, 2013 10:55 am
Excel Ver: 2010

Re: สอบถามสูตรการ วนLoop นำข้อมูลไปบันทึก

#9

Post by sakajohn »

ผมแนบไฟล์ได้แล้วครับ

Code: Select all

Sub Macro5()
'
'

Dim r, rAll As Range
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

'Workbooks("DataPlan.xlsx").Save
Set rg = Range("AH6")
rg.Activate
If Application.CountA(Range("AH6")) = 0 Then
    MsgBox "äÁèÁÕ¢éÍÁÙÅãËéºÑ¹·Ö¡"
    Application.Calculation = xlCalculationAutomatic
    Exit Sub
End If
Set rg = Range("Q3")
rg.Activate
If Application.CountA(Range("S3")) = 0 Then
    MsgBox "ãÊèÇѹ·Õè¼ÅÔµ§Ò¹´éÇÂ"
  Application.Calculation = xlCalculationAutomatic
    Exit Sub
End If
MsgBox ("ÍÂèÒÅ×Áà»ÅÕ蹡ÃдÒɹФÃѺ"), vbCritical
ActiveSheet.Unprotect Password:="1234"

Workbooks("DataBase.xlsx").Saved = False
ThisWorkbook.Activate
Set rAll = Range("AH6:AH" & Range("AH" & Rows.Count).End(xlUp).Row)
 For Each r In rAll
    If r.Value <> "" Then
     r.Offset(0, 5).Resize(1, 5).Copy
    'Workbooks.Open Filename:="\\ACCOUNT\Data (D)\SALE\DataBase.xlsx"
  ThisWorkbook.Activate
    Application.Goto Reference:= _
        "OFFSET('[DataBase.xlsx]Sheet1'!R1C1,MATCH(R6C34,INDEX('[DataBase.xlsx]Sheet1'!R2C1:R50000C1,0),0),37)"
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
   End If
    
 '----------------------------------------------------------------------------------------------------------------------------------------------------
    ThisWorkbook.Activate
    Next r
    Workbooks("Dataplan.xlsx").Save
    If Range("AH6").Value <> "" Then
   'ActiveSheet.Unprotect Password:="1234"
    Application.Goto Reference:="OFFSET(R6C34,0,4,1,10)"
       Selection.Copy
  ThisWorkbook.Activate
    Application.Goto Reference:= _
        "OFFSET('[DataPlan.xlsx]Sheet1'!R1C1,MATCH(R6C34,INDEX('[DataPlan.xlsx]Sheet1'!R2C1:R50000C1,0),0),25)"
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False

   End If
        ThisWorkbook.Activate
  
If Range("AH7").Value <> "" Then
   
    Application.Goto Reference:="OFFSET(R7C34,0,4,1,10)"
       Selection.Copy
  ThisWorkbook.Activate
    Application.Goto Reference:= _
        "OFFSET('[DataPlan.xlsx]Sheet1'!R1C1,MATCH(R7C34,INDEX('[DataPlan.xlsx]Sheet1'!R2C1:R50000C1,0),0),25)"
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    
   End If
     ThisWorkbook.Activate
If Range("AH8").Value <> "" Then
      Application.Goto Reference:="OFFSET(R8C34,0,4,1,10)"
       Selection.Copy
  ThisWorkbook.Activate
    Application.Goto Reference:= _
        "OFFSET('[DataPlan.xlsx]Sheet1'!R1C1,MATCH(R8C34,INDEX('[DataPlan.xlsx]Sheet1'!R2C1:R50000C1,0),0),25)"
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
   End If
       ThisWorkbook.Activate
If Range("AH9").Value <> "" Then
     Application.Goto Reference:="OFFSET(R9C34,0,4,1,10)"
       Selection.Copy
  ThisWorkbook.Activate
    Application.Goto Reference:= _
        "OFFSET('[DataPlan.xlsx]Sheet1'!R1C1,MATCH(R9C34,INDEX('[DataPlan.xlsx]Sheet1'!R2C1:R50000C1,0),0),25)"
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
   
   End If
       ThisWorkbook.Activate
    If Range("AH10").Value <> "" Then
     Application.Goto Reference:="OFFSET(R10C34,0,4,1,10)"
       Selection.Copy
  ThisWorkbook.Activate
    Application.Goto Reference:= _
        "OFFSET('[DataPlan.xlsx]Sheet1'!R1C1,MATCH(R10C34,INDEX('[DataPlan.xlsx]Sheet1'!R2C1:R50000C1,0),0),25)"
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
   End If
         ThisWorkbook.Activate
 If Range("AH11").Value <> "" Then
      Application.Goto Reference:="OFFSET(R11C34,0,4,1,10)"
       Selection.Copy
  ThisWorkbook.Activate
    Application.Goto Reference:= _
        "OFFSET('[DataPlan.xlsx]Sheet1'!R1C1,MATCH(R11C34,INDEX('[DataPlan.xlsx]Sheet1'!R2C1:R50000C1,0),0),25)"
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
   End If
      ThisWorkbook.Activate
If Range("AH12").Value <> "" Then
      Application.Goto Reference:="OFFSET(R12C34,0,4,1,10)"
       Selection.Copy
  ThisWorkbook.Activate
    Application.Goto Reference:= _
        "OFFSET('[DataPlan.xlsx]Sheet1'!R1C1,MATCH(R12C34,INDEX('[DataPlan.xlsx]Sheet1'!R2C1:R50000C1,0),0),25)"
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False

    End If
       ThisWorkbook.Activate
    If Range("AH13").Value <> "" Then
   'ActiveSheet.Unprotect Password:="1234"
    Application.Goto Reference:="OFFSET(R13C34,0,4,1,10)"
       Selection.Copy
  ThisWorkbook.Activate
    Application.Goto Reference:= _
        "OFFSET('[DataPlan.xlsx]Sheet1'!R1C1,MATCH(R13C34,INDEX('[DataPlan.xlsx]Sheet1'!R2C1:R50000C1,0),0),25)"
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
   End If
     ThisWorkbook.Activate
    If Range("AH14").Value <> "" Then
     Application.Goto Reference:="OFFSET(R14C34,0,4,1,10)"
       Selection.Copy
  ThisWorkbook.Activate
    Application.Goto Reference:= _
        "OFFSET('[DataPlan.xlsx]Sheet1'!R1C1,MATCH(R14C34,INDEX('[DataPlan.xlsx]Sheet1'!R2C1:R50000C1,0),0),25)"
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
   End If
     ThisWorkbook.Activate
If Range("AH15").Value <> "" Then
    Application.Goto Reference:="OFFSET(R15C34,0,4,1,10)"
       Selection.Copy
  ThisWorkbook.Activate
    Application.Goto Reference:= _
        "OFFSET('[DataPlan.xlsx]Sheet1'!R1C1,MATCH(R15C34,INDEX('[DataPlan.xlsx]Sheet1'!R2C1:R50000C1,0),0),25)"
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
   End If
         ThisWorkbook.Activate
    If Range("AH16").Value <> "" Then
     Application.Goto Reference:="OFFSET(R16C34,0,4,1,10)"
       Selection.Copy
  ThisWorkbook.Activate
    Application.Goto Reference:= _
        "OFFSET('[DataPlan.xlsx]Sheet1'!R1C1,MATCH(R16C34,INDEX('[DataPlan.xlsx]Sheet1'!R2C1:R50000C1,0),0),25)"
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
   End If
         ThisWorkbook.Activate
    If Range("AH17").Value <> "" Then
     Application.Goto Reference:="OFFSET(R17C34,0,4,1,10)"
       Selection.Copy
  ThisWorkbook.Activate
    Application.Goto Reference:= _
        "OFFSET('[DataPlan.xlsx]Sheet1'!R1C1,MATCH(R17C34,INDEX('[DataPlan.xlsx]Sheet1'!R2C1:R50000C1,0),0),25)"
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
   End If
       ThisWorkbook.Activate
    If Range("AH18").Value <> "" Then
    Application.Goto Reference:="OFFSET(R18C34,0,4,1,10)"
       Selection.Copy
  ThisWorkbook.Activate
    Application.Goto Reference:= _
        "OFFSET('[DataPlan.xlsx]Sheet1'!R1C1,MATCH(R18C34,INDEX('[DataPlan.xlsx]Sheet1'!R2C1:R50000C1,0),0),25)"
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
   End If
      ThisWorkbook.Activate
    If Range("AH19").Value <> "" Then
     Application.Goto Reference:="OFFSET(R19C34,0,4,1,10)"
       Selection.Copy
  ThisWorkbook.Activate
    Application.Goto Reference:= _
        "OFFSET('[DataPlan.xlsx]Sheet1'!R1C1,MATCH(R19C34,INDEX('[DataPlan.xlsx]Sheet1'!R2C1:R50000C1,0),0),25)"
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
   End If
         ThisWorkbook.Activate
    If Range("AH20").Value <> "" Then
    Application.Goto Reference:="OFFSET(R20C34,0,4,1,10)"
       Selection.Copy
  ThisWorkbook.Activate
    Application.Goto Reference:= _
        "OFFSET('[DataPlan.xlsx]Sheet1'!R1C1,MATCH(R20C34,INDEX('[DataPlan.xlsx]Sheet1'!R2C1:R50000C1,0),0),25)"
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
   End If
       ThisWorkbook.Activate
    If Range("AH21").Value <> "" Then
    Application.Goto Reference:="OFFSET(R21C34,0,4,1,10)"
       Selection.Copy
  ThisWorkbook.Activate
    Application.Goto Reference:= _
        "OFFSET('[DataPlan.xlsx]Sheet1'!R1C1,MATCH(R21C34,INDEX('[DataPlan.xlsx]Sheet1'!R2C1:R50000C1,0),0),25)"
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
   End If
         ThisWorkbook.Activate
    If Range("AH22").Value <> "" Then
      Application.Goto Reference:="OFFSET(R22C34,0,4,1,10)"
       Selection.Copy
  ThisWorkbook.Activate
    Application.Goto Reference:= _
        "OFFSET('[DataPlan.xlsx]Sheet1'!R1C1,MATCH(R22C34,INDEX('[DataPlan.xlsx]Sheet1'!R2C1:R50000C1,0),0),25)"
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
   End If
        ThisWorkbook.Activate
    If Range("AH23").Value <> "" Then
    Application.Goto Reference:="OFFSET(R23C34,0,4,1,10)"
       Selection.Copy
  ThisWorkbook.Activate
    Application.Goto Reference:= _
        "OFFSET('[DataPlan.xlsx]Sheet1'!R1C1,MATCH(R23C34,INDEX('[DataPlan.xlsx]Sheet1'!R2C1:R50000C1,0),0),25)"
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
   End If
      ThisWorkbook.Activate
    If Range("AH24").Value <> "" Then
    Application.Goto Reference:="OFFSET(R24C34,0,4,1,10)"
       Selection.Copy
  ThisWorkbook.Activate
    Application.Goto Reference:= _
        "OFFSET('[DataPlan.xlsx]Sheet1'!R1C1,MATCH(R24C34,INDEX('[DataPlan.xlsx]Sheet1'!R2C1:R50000C1,0),0),25)"
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
   End If
   
   '---------------------------------------------------------------------------------------------------------
   
    ThisWorkbook.Activate
    Workbooks("DataPlan.xlsx").Save
    
    Workbooks("DataBase.xlsx").Save
 
        
        
    Sheets("M01").Select
     ThisWorkbook.Save
  
    Range("Q3").Select
    Selection.ClearContents
    
    
    ActiveSheet.Protect Password:="1234"
    'MsgBox ("ºÑ¹·Ö¡¢éÍÁÙÅàÃÕºÃéÍÂ"), vbInformation
  ThisWorkbook.Save
Application.Calculation = xlCalculationAutomatic
    Range("C6").Select
    Application.ScreenUpdating = True

End Sub
ไม่สามารถเอาCodeใส่ได้ครับ ไฟล์จะใหญ่เกินครับ
You do not have the required permissions to view the files attached to this post.
Top
User avatar
snasui
Site Admin
Site Admin
Posts: 31256
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 2019
Contact:
Contact snasui

Re: สอบถามสูตรการ วนLoop นำข้อมูลไปบันทึก

#10

Post by snasui »

:D ไม่พบ Code ในไฟล์ที่แนบมา กรุณาแนบไฟล์ที่มี Code มาใหม่ครับ
Top
sakajohn
Member
Member
Posts: 229
Joined: Tue Aug 06, 2013 10:55 am
Excel Ver: 2010

Re: สอบถามสูตรการ วนLoop นำข้อมูลไปบันทึก

#11

Post by sakajohn »

ผมใส่codeแล้วไฟล์ ประมาณ900kbครับ เลยต้องแยกcodeมาต่างหากครับ ปกติcodeจะอยู่module1ครับ
Top
User avatar
snasui
Site Admin
Site Admin
Posts: 31256
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 2019
Contact:
Contact snasui

Re: สอบถามสูตรการ วนLoop นำข้อมูลไปบันทึก

#12

Post by snasui »

:D ไฟล์เดิมขนาด 80.41k เมื่อใส่ Code แล้วใหญ่เป็นขนาดนั้นแสดงว่า Code จะต้องมีนับพันบรรทัดครับ
Top
sakajohn
Member
Member
Posts: 229
Joined: Tue Aug 06, 2013 10:55 am
Excel Ver: 2010

Re: สอบถามสูตรการ วนLoop นำข้อมูลไปบันทึก

#13

Post by sakajohn »

Codeจะอยู่ที่ไฟล์daily module1 ครับ codeคือตามที่โพสไว้ครับ พอใส่codeไฟล์จะเกินครับ
Top
sakajohn
Member
Member
Posts: 229
Joined: Tue Aug 06, 2013 10:55 am
Excel Ver: 2010

Re: สอบถามสูตรการ วนLoop นำข้อมูลไปบันทึก

#14

Post by sakajohn »

ผมต้องsaveแบบxlsbครับ โหลดไม่ผ่านจริงๆครับ ไม่ทราบเพราะสาเหตุอะไรครับ
Top
User avatar
snasui
Site Admin
Site Admin
Posts: 31256
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 2019
Contact:
Contact snasui

Re: สอบถามสูตรการ วนLoop นำข้อมูลไปบันทึก

#15

Post by snasui »

:D Code ผมมีหลักพันถึงหลักหมื่นบรรทัด ลองเปรียบเทียบเร็ว ๆ แล้วไม่น่าจะใหญ่ได้ขนาดนั้นครับ
Top
sakajohn
Member
Member
Posts: 229
Joined: Tue Aug 06, 2013 10:55 am
Excel Ver: 2010

Re: สอบถามสูตรการ วนLoop นำข้อมูลไปบันทึก

#16

Post by sakajohn »

ตอนนี้ใช้วิธีเขียนcodeซ้ำไปเรื่อยตั้งแต่ AH6 ถึงAH41ครับ เปลี่ยนตัวเลขเอาครับ

Code: Select all


    If Range("AH6").Value <> "" Then
    Application.Goto Reference:="OFFSET(R6C34,0,5,1,5)"
       Selection.Copy
    'Workbooks.Open Filename:="\\ACCOUNT\Data (D)\SALE\DataBase.xlsx"
  ThisWorkbook.Activate
    Application.Goto Reference:= _
        "OFFSET('[DataBase.xlsx]Sheet1'!R1C1,MATCH(R6C34,INDEX('[DataBase.xlsx]Sheet1'!R2C1:R50000C1,0),0),37)"
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
   End If
Top
sakajohn
Member
Member
Posts: 229
Joined: Tue Aug 06, 2013 10:55 am
Excel Ver: 2010

Re: สอบถามสูตรการ วนLoop นำข้อมูลไปบันทึก

#17

Post by sakajohn »

หรือเป็นเพราะสูตร vlookup ด้วยหรือเปล่าครับ แต่ผมพยายามแล้วครับ โหลดไม่ผ่านครับ
Top
User avatar
snasui
Site Admin
Site Admin
Posts: 31256
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 2019
Contact:
Contact snasui

Re: สอบถามสูตรการ วนLoop นำข้อมูลไปบันทึก

#18

Post by snasui »

:D ทำมาพอเป็นตัวอย่างเพียงไม่กี่รายการให้พอเป็นตัวแทนของข้อมูลจริง ไฟล์คำถามกับไฟล์จริงควรแยกต่างหากจากกัน ขนาดไฟล์ตัวอย่างย่อมต้องไม่มีขนาดใหญ่ ตัดสิ่งที่ไม่เกี่ยวข้องกับปัญหาทิ้งใปทั้งหมด เช่นสูตรหรือรูปภาพต่าง ๆ ครับ
Top
User avatar
snasui
Site Admin
Site Admin
Posts: 31256
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 2019
Contact:
Contact snasui

Re: สอบถามสูตรการ วนLoop นำข้อมูลไปบันทึก

#19

Post by snasui »

sakajohn wrote: Tue Nov 05, 2019 9:51 pm หรือเป็นเพราะสูตร vlookup ด้วยหรือเปล่าครับ แต่ผมพยายามแล้วครับ โหลดไม่ผ่านครับ
:D คำถามที่โพสต์ติด ๆ กันให้โพสต์ไว้ในกล่องความเห็นเดียวกันครับ
Top
sakajohn
Member
Member
Posts: 229
Joined: Tue Aug 06, 2013 10:55 am
Excel Ver: 2010

Re: สอบถามสูตรการ วนLoop นำข้อมูลไปบันทึก

#20

Post by sakajohn »

ต้องขออภัยด้วยครับ
Top
Post Reply

Return to “Excel Formulas & Functions”