Page 1 of 1
รบกวนแก้ code เพื่อให้ copy ข้อมูลcolume ระหว่าง2 workbook
Posted: Fri Apr 11, 2014 9:01 pm
by somkiatfem
Sheet1.Cells(1, 1) = "= 'D:\Work-Analytic\100 ABT-Analytic Base Table\Document\" & "[Map Source - Target.xlsx]Sheet1'!C1"
คือผมอยาก copy ข้อมูลของ columeA ของไฟล์ใดๆ มาเรียงต่อกัน รวมกันในไฟล์ที่ใช้ vba ครับ
อันนี้ผมแก้ตรง columns(1) อย่างเดียว แต่ไม่รู้ในส่วน" Sheet1'!C1 " ต้องแก้เป็นอะไรครับ
Sheet1.Columns(1) = "= 'D:\Work-Analytic\100 ABT-Analytic Base Table\Document\" & "[Map Source - Target.xlsx]Sheet1'!C1"
Re: รบกวนแก้ code เพื่อให้ copy ข้อมูลcolume ระหว่าง2 workbo
Posted: Fri Apr 11, 2014 9:15 pm
by bank9597
somkiatfem wrote:Sheet1.Cells(1, 1) = "= 'D:\Work-Analytic\100 ABT-Analytic Base Table\Document\" & "[Map Source - Target.xlsx]Sheet1'!C1"
คือผมอยาก copy ข้อมูลของ columeA ของไฟล์ใดๆ มาเรียงต่อกัน รวมกันในไฟล์ที่ใช้ vba ครับ
อันนี้ผมแก้ตรง columns(1) อย่างเดียว แต่ไม่รู้ในส่วน" Sheet1'!C1 " ต้องแก้เป็นอะไรครับ
Sheet1.Columns(1) = "= 'D:\Work-Analytic\100 ABT-Analytic Base Table\Document\" & "[Map Source - Target.xlsx]Sheet1'!C1"
แนบไฟล์ พร้อมโจทย์มาดูอีกครั้งครับ
Re: รบกวนแก้ code เพื่อให้ copy ข้อมูลcolume ระหว่าง2 workbo
Posted: Fri Apr 11, 2014 10:16 pm
by somkiatfem
มี 3 files ครับ โดยนำ "colume colse " มาจากไฟล์ ที่เป็นวันที่ ทั้งสองไฟล์ มาต่อกันแบบ vlookup ในไฟล์ s ครับ ขอบคุณครับคืออยากให้วนloop หรือupdate ไฟล์ที่มาใหม่ๆทุกวันด้วยนะครับมาต่อๆกันไปเรื่อยๆนะครับ
Re: รบกวนแก้ code เพื่อให้ copy ข้อมูลcolume ระหว่าง2 workbo
Posted: Fri Apr 11, 2014 10:44 pm
by snasui
การวนลูปจะต้องใช้ VBA ปกติแล้วถ้าใช้สูตรเราจะไม่เรียกวนลูปครับ
สำหรับตัวอย่างไฟล์ที่แนบมาสามารถที่จะคีย์สูตรเพื่อรองรับชื่อไฟล์ไว้ล่วงหน้าได้ ยกตัวอย่างเช่น
เซลล์ C2 คีย์
=IFERROR(VLOOKUP($A2,'[set-history_EOD_2014-01-07.xlsx]Sheet1'!$A$1:$G$1135,6,FALSE),"")
Enter > Copy ไปทางขวา แล้วเปลี่ยน -07 เป็น -08, -09 ไปเรื่อย ๆ เมื่อโปรแกรม Pop-up ให้เปิดไฟล์ให้คลิก Cancel ไปก่อน ข้อมูลจะมาแสดงเมื่อมีการบันทึกชื่อไฟล์ที่มีในสูตร กรณีทีบันทึกเข้ามาแล้วข้อมูลไม่ Update ให้เข้าเมนู Data > Edit Link > Open Source > เปิดไฟล์ต้นทาง
Re: รบกวนแก้ code เพื่อให้ copy ข้อมูลcolume ระหว่าง2 workbo
Posted: Sat Apr 12, 2014 7:57 pm
by somkiatfem
ขอความกรุณาท่านอาจารย์ผู้รู้ คือจริงๆผมต้องการ out put เป็นอย่างที่อาจารย์ได้เห็นครับ แต่ผมต้องการสร้างโดยการเขียนโดยใช้ vba ครับ ซึ่งผมได้ศึกษามาบ้างดูเหมือนว่าผมต้องเขียนเป็นเกี่ยวกับdata base ใช้ ADO แต่เหมือนจะยุ่งยากเกินไป ผมจึงควรต้องการแค่เปิดมาทีละไฟล์เเล้ว copy มาเรียงไว้ตามลำดับ เเล้วปิด เเล้วเปิดใหม่เรียงตามวันที่ที่มากขึ้นเรื่อยๆ ครับโดย โปรแกรมสามารถจำค่าวันล่าสุดได้ เมื่อมีไฟล์วันที่ใหม่มาจึงทำการ copy เเล้วนำไปวางในตำแหน่งนั้นตามลำดับต่อไปครับ ขอบคุณครับ
แก้ code ให้ทีครับไม่ทราบผิดตรงไหน
Posted: Sun Apr 13, 2014 12:01 am
by somkiatfem
Public Sub openq()
Dim c As Integer, i As Integer, j As Integer
For c = 1 To 3
For i = 1 To 10 '
Sheet1.Cells(i, c) = "= 'C:\Users\somkiat\Desktop\aaa\[" & c & ".xlsx]Sheet1'! cells( " & i & "," & c & ")" <---codeนี้ พิมพ์output= #NAME?
'Sheet1.Cells(i, 1) = "= 'C:\Users\somkiat\Desktop\aaa\[" & c & ".xlsx]Sheet1'!a" & i <---code นี้จะพิมพ์ตัวเลขออกมาตามปกติครับ
Next i
Next c
End Sub
Re: รบกวนแก้ code เพื่อให้ copy ข้อมูลcolume ระหว่าง2 workbo
Posted: Sun Apr 13, 2014 12:18 am
by bank9597
somkiatfem wrote:ขอความกรุณาท่านอาจารย์ผู้รู้ คือจริงๆผมต้องการ out put เป็นอย่างที่อาจารย์ได้เห็นครับ แต่ผมต้องการสร้างโดยการเขียนโดยใช้ vba ครับ ซึ่งผมได้ศึกษามาบ้างดูเหมือนว่าผมต้องเขียนเป็นเกี่ยวกับdata base ใช้ ADO แต่เหมือนจะยุ่งยากเกินไป ผมจึงควรต้องการแค่เปิดมาทีละไฟล์เเล้ว copy มาเรียงไว้ตามลำดับ เเล้วปิด เเล้วเปิดใหม่เรียงตามวันที่ที่มากขึ้นเรื่อยๆ ครับโดย โปรแกรมสามารถจำค่าวันล่าสุดได้ เมื่อมีไฟล์วันที่ใหม่มาจึงทำการ copy เเล้วนำไปวางในตำแหน่งนั้นตามลำดับต่อไปครับ ขอบคุณครับ
ผมดูไฟล์แล้วครับ เห็นชัดเจนว่าข้อมูลในไฟล์นั้น มีการจัดเก็บที่เหมือนๆกัน เลยสงสัยว่าทำไมไม่เก็บข้อมูลไว้ในไฟล์เดียวกันเป็นฐานข้อมูล แล้วดึงมาแสดงในหน้ารายงาน ซึ่งมันจะง่ายกว่าการที่ต้องแยกเป็นคนละไฟล์มาก เพราะการดึงข้อมูลข้ามไฟลนั้น ต้องใช้พวก connection string พวก ADO ซึ่งเป็นเรื่องที่ยากมาก
แต่หากข้อมูลเราเก็บไว้ในไฟล์เดียวกัน การดึงข้อมูลมาแสดงก็จะทำง่ายนิดเดียว ไม่ว่าจะใช้สูตรหรือว่า vba ก็ตามครับ
Re: รบกวนแก้ code เพื่อให้ copy ข้อมูลcolume ระหว่าง2 workbo
Posted: Sun Apr 13, 2014 12:40 am
by somkiatfem
คือเป็นไฟล์ที่ updateจากแหล่งอื่น มาทุกวันครับ ผมจึงอยากเก็บข้อมูลบางส่วนของไฟล์ให้มาจัดเรียงรวมกันในไฟล์ที่จะนำไปใช้งานต่อครับ
Re: รบกวนแก้ code เพื่อให้ copy ข้อมูลcolume ระหว่าง2 workbo
Posted: Sun Apr 13, 2014 1:11 am
by bank9597
somkiatfem wrote:คือเป็นไฟล์ที่ updateจากแหล่งอื่น มาทุกวันครับ ผมจึงอยากเก็บข้อมูลบางส่วนของไฟล์ให้มาจัดเรียงรวมกันในไฟล์ที่จะนำไปใช้งานต่อครับ
ถ้าเป็นอย่างนั้น คุณก็ควรรวมข้อมูลจากไฟล์ที่ต้องการมารวมไว้ในไฟล์เดียวกันก่อน แล้วค่อยทำการดึงข้อมูลไปแสดงในหน้ารายงานครับ
คุณลองเอาโค๊ดนี้ไป Run ครับ สามารถเลือกไฟล์ที่ต้องการได้ไม่จำกัด ไม่จำกัดไฟล์เวอร์ชั่น มันจะรวมข้อมูลดิบมาต่อกันในชีทเดียว เหมาะอย่างยิ่งกับข้อมูลที่จัดเก็บแบบฐานข้อมูลและมีรูปแบบเหมือนกันทุกไฟล์
เครดิต : อาจารย์ snasui จากกระทู้
viewtopic.php?f=9&t=3228
Code: Select all
Option Explicit
Sub CollectData()
Dim sh As Worksheet, thisBook As Workbook, strThisbook As Variant
Dim ob As Workbook, i As Integer, rRow As Long, tg As Range
Set ob = ThisWorkbook
ob.Sheets(1).UsedRange.Clear
strThisbook = Application.GetOpenFilename(Filefilter:= _
"All File (*.*), *.*", Title:="Please select source file(s).", MultiSelect:=True)
If TypeName(strThisbook) = "Boolean" Then
MsgBox "Please select file(s)."
Exit Sub
End If
rRow = 1
For i = 1 To UBound(strThisbook)
Set thisBook = Workbooks.Open(strThisbook(i))
Application.ScreenUpdating = False
For Each sh In thisBook.Worksheets
sh.UsedRange.Copy
ob.Sheets(1).Range("a" & rRow).PasteSpecial xlPasteValues
rRow = ob.Sheets(1).UsedRange.Rows.Count + 1
Application.CutCopyMode = False
Next sh
thisBook.Saved = True
thisBook.Close
Next i
Application.ScreenUpdating = True
MsgBox "Data already collected."
End Sub
Re: รบกวนแก้ code เพื่อให้ copy ข้อมูลcolume ระหว่าง2 workbo
Posted: Sun Apr 13, 2014 9:17 am
by somkiatfem
ขอบคุณมากครับผมจะนำไปลองใช้ครับ