Snasui Excel Forum

Posted: **Mon Nov 04, 2019 4:12 pm**

รบกวนสอบถามครับ ผมต้องการนำข้อมูล จากบรรทัด 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แบบอื่นไหมที่สะดวกว่านี้ครับ

Posted: **Mon Nov 04, 2019 5:22 pm**

ควรแบบไฟล์ตัวอย่างที่ต้องการขยายไป อย่างไร พร้อมกับโค้ดมาในไฟล์นั้นๆด้วย ครับจะได้ตอบได้ตรงประเด็นครับ

Posted: **Mon Nov 04, 2019 6:13 pm**

ไฟล์ 900 kb ทำไมฟ้องว่าใหญ่เกินไปไม่สามารถ Add fileได้ครับ พยายามตัดที่ไม่จำเป็นออกหมดแล้วครับ

Posted: **Mon Nov 04, 2019 6:28 pm**

มีวิธีแนบไฟล์แบบไหนได้บ้างครับ ตอนนี้ลบจนไม่เหลือข้อมูลยัง 900 kb อยู่เลยครับ เกี่ยวกับcode ที่เขียนยาวไปไหมครับ ถึงทำให้ไฟล์มีขนาดใหญ่

Posted: **Mon Nov 04, 2019 6:45 pm**

ได้แล้วครับ save เป็นไฟล์ xlbs

Posted: **Mon Nov 04, 2019 8:02 pm**

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

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

Posted: **Mon Nov 04, 2019 10:51 pm**

รบกวนสอบถามครับ 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 ครับ ไม่ได้วางตามรหัสตรงกันครับ จากนั้น ก็ วน ไม่ไปไหนเลยครับ ทั้งที่ข้อมูลก็หมดแล้วครับ

Posted: **Mon Nov 04, 2019 10:51 pm**

รบกวนสอบถามครับ 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 ครับ ไม่ได้วางตามรหัสตรงกันครับ จากนั้น ก็ วน ไม่ไปไหนเลยครับ ทั้งที่ข้อมูลก็หมดแล้วครับ

Posted: **Tue Nov 05, 2019 12:04 am**

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

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ใส่ได้ครับ ไฟล์จะใหญ่เกินครับ

Posted: **Tue Nov 05, 2019 9:11 pm**

ไม่พบ Code ในไฟล์ที่แนบมา กรุณาแนบไฟล์ที่มี Code มาใหม่ครับ

Posted: **Tue Nov 05, 2019 9:37 pm**

ผมใส่codeแล้วไฟล์ ประมาณ900kbครับ เลยต้องแยกcodeมาต่างหากครับ ปกติcodeจะอยู่module1ครับ

Posted: **Tue Nov 05, 2019 9:40 pm**

ไฟล์เดิมขนาด 80.41k เมื่อใส่ Code แล้วใหญ่เป็นขนาดนั้นแสดงว่า Code จะต้องมีนับพันบรรทัดครับ

Posted: **Tue Nov 05, 2019 9:40 pm**

Codeจะอยู่ที่ไฟล์daily module1 ครับ codeคือตามที่โพสไว้ครับ พอใส่codeไฟล์จะเกินครับ

Posted: **Tue Nov 05, 2019 9:41 pm**

ผมต้องsaveแบบxlsbครับ โหลดไม่ผ่านจริงๆครับ ไม่ทราบเพราะสาเหตุอะไรครับ

Posted: **Tue Nov 05, 2019 9:42 pm**

Code ผมมีหลักพันถึงหลักหมื่นบรรทัด ลองเปรียบเทียบเร็ว ๆ แล้วไม่น่าจะใหญ่ได้ขนาดนั้นครับ

Posted: **Tue Nov 05, 2019 9:49 pm**

ตอนนี้ใช้วิธีเขียน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

Posted: **Tue Nov 05, 2019 9:51 pm**

หรือเป็นเพราะสูตร vlookup ด้วยหรือเปล่าครับ แต่ผมพยายามแล้วครับ โหลดไม่ผ่านครับ

Posted: **Tue Nov 05, 2019 9:54 pm**

ทำมาพอเป็นตัวอย่างเพียงไม่กี่รายการให้พอเป็นตัวแทนของข้อมูลจริง ไฟล์คำถามกับไฟล์จริงควรแยกต่างหากจากกัน ขนาดไฟล์ตัวอย่างย่อมต้องไม่มีขนาดใหญ่ ตัดสิ่งที่ไม่เกี่ยวข้องกับปัญหาทิ้งใปทั้งหมด เช่นสูตรหรือรูปภาพต่าง ๆ ครับ

Posted: **Tue Nov 05, 2019 9:56 pm**

sakajohn wrote: Tue Nov 05, 2019 9:51 pm หรือเป็นเพราะสูตร vlookup ด้วยหรือเปล่าครับ แต่ผมพยายามแล้วครับ โหลดไม่ผ่านครับ

คำถามที่โพสต์ติด ๆ กันให้โพสต์ไว้ในกล่องความเห็นเดียวกันครับ

Posted: **Tue Nov 05, 2019 10:07 pm**

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

Snasui Excel Forum

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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