สอบถามวิธีตัด part ให้เหลือแต่ชื่อของ workbook

[nc_jajah]

ตอนนี้ได้ part ของ workbook มาแล้วค่ะ
โดยใช้ code ข้างล่างนี้

Code: Select all

Sub ListAllFiles()
    Dim fs As FileSearch, ws As Worksheet, i As Long    
    Dim files() As String
    Set fs = Application.FileSearch
    With fs
        .SearchSubFolders = False 
        .fileType = msoFileTypeAllFiles 
        .LookIn = TextBox1.Text 
        If .Execute > 0 Then
            For i = 1 To .FoundFiles.count
            ReDim Preserve files(i)
               files(i) = .FoundFiles(i)
            Next
        Else
            MsgBox "No files found"
        End If
    End With    
End Sub

ต่อไปต้องการจะตัดจาก part ที่ได้ให้เหลือแค่ชื่อ workbook ต้องทำยังไงหรอคะ

[joo]

ช่วยแนบไฟล์พร้อมเงื่อนไขและตัวอย่างคำตอบที่ต้องการมาด้วยครับ

[nc_jajah]

ตอนนี้ในตัวแปร files() จะมีชื่อ part ตามจำนวนไฟล์ที่ใน Folder นั้นๆ มี เช่น
files(1) = C:\Documents and Settings\Sample.xls
files(2) = C:\Documents and Settings\Sample2.xls

ต้องการจะได้แค่ Sample.xls, Sample2.xls ซึ่งจะเก็บค่านี้ไว้ในตัวแปรซักตัวค่ะ

[snasui]

ลองดูตัวอย่าง Code ตามด้านล่างครับ

Code: Select all

Sub ListAllFiles()
    Dim fs As FileSearch, ws As Worksheet, i As Long
    Dim files() As String
    Dim j As Integer, k As Integer
    Set fs = Application.FileSearch
    With fs
        .SearchSubFolders = False
        .FileType = msoFileTypeAllFiles
        .LookIn = TextBox1.Text
        If .Execute > 0 Then
            For i = 1 To .FoundFiles.Count
            ReDim Preserve files(i)
                For j = 1 To Len(.FoundFiles(i))
                    If Mid(.FoundFiles(i), j, 1) = "\" Then
                        k = j + 1
                    End If
                Next j
               files(i) = Mid(.FoundFiles(i), k, 255)
            Next
        Else
            MsgBox "No files found"
        End If
    End With
End Sub

[nc_jajah]

ได้แล้วค่ะ
เป็นการประยุกต์ใช้คำสั่งที่คาดไม่ถึงจริงๆ
ขอบคุณมากๆ ค่ะ

[nc_jajah]

รบกวนถามต่อนะคะ
ต้องการรวม Function ListAllFiles() กับ send_data() เข้าด้วยกันค่ะ

โดย Workbooks หลักคือ Sample.xls
จุดประสงค์คือต้องการคัดลอก cell a1:g7 จาก Worksheets : Sheet1, Workbooks : Sample2.xls
ไปไว้ที่ Worksheets : Sheet1, Workbooks : Sample3.xls

ลองทำตามไฟล์ที่แนบแล้วติด error ค่ะ

อันที่จริงชื่อ Workbooks หรือ Worksheets จะแทนด้วยตัวแปรค่ะ
แต่ตอนนี้ค่อยๆทำไปทีละขั้นตอนก่อน
ก็เลยใช้ชื่อ Workbooks, Worksheets ตรงๆ ไปเลย

รบกวนช่วยดูให้หน่อยนะคะ

[snasui]

ลองปรับ Code เป็นตามด้านล่างครับ

Code: Select all

'Other code
Set wbk2 = Workbooks.Open("Sample3.xls", False, False)
    
With wbk2.Sheets("Sheet1")
    Set rs = .Range("A" & Rows.count).End(xlUp).Offset(1, 0)
End With
'Other code

[nc_jajah]

ไ้ด้แล้วค่ะ ขอบคุณมากๆ

ถ้าเราจะเปลี่ยนที่เก็บข้อมูลนี้ เป็นเก็บลง Access จะใช้ตัวแปร rt ได้เลยมั๊ยคะ

[snasui]

การบันทึกไปที่ Access หรือ SQL ต้องใช้ Connection String ใช้ Record Set ใช้ SQL Statement ในการ Insert ค่าเข้าไปใน Table ไม่สามารถบันทึกตรง ๆ เหมือนบันทึกลงในชีท Excel ครับ

[nc_jajah]

โอเคค่ะ งั้นพักตรงนั้นไว้ก่อน
ตอนนี้กำลังทำส่วนของการคัดเลือกข้อมูล
ถ้ามีปัญหาหรือข้อสงสัยจะมารบกวนอีกครั้งนะคะ
ขอบคุณทุกๆ คห. ค่ะ

[nc_jajah]

พอดีไปเจอ code ของคุณคนควนที่
http://snasui.blogspot.com/2011/06/vba_26.html
คิดว่าจะนำมาประยุกต์ใช้กับงานที่กำลังทำอยู่

ตอนนี้ลองแก้ส่วนของการคัดลอกข้อมูลแล้วแต่ติดปัญหาค่ะ
ส่วนนี้อยู่ที่ Workbooks : Sample.xls, Function copy_data() ค่ะ
ตรง

Code: Select all

If r = ("COMMODITY") Then
            ReDim Preserve a(lng)
            a(lng) = lng
            a(lng) = r(i + 1).Offset(0, 1)
            lng = lng + 1
End If

ซึ่งพอรันแล้วติด error ค่ะ
ไม่ทราบว่าต้องแก้ code นี้ยังไงหรอคะ

จริงๆ จะ copy ใน Workbooks : Sample2.xls, Sheets : Sheet1 ตั้งแต่ cell A4 จนถึง cell สุดท้าย ซึ่งเราไม่ทราบว่า cell สุดท้ายสิ้นสุดที่ไหน (ในไฟล์ตัวอย่างคือ G4) แล้วเก็บในตัวแปรแยกกันไว้ค่ะ
ตอนนี้เลย copy แค่ cell เดียวก่อน ถ้าได้ตัวนี้แล้วค่อยเพิ่มส่วนอื่นต่อ
ผลลัพธ์จริงๆ หลังงานนี้เสร็จคือใน Sheet3 ค่ะ

[nc_jajah]

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

[snasui]

Code ที่เขียนมานั้นติดบรรทัดไหนครับ

[nc_jajah]

ตรงนี้ค่ะ

Code: Select all

For j = 1 To wbk.Sheets("Sheet1").Range("A" & Rows.count).End(xlUp)
                ReDim Preserve a(j, lng)
                a(j, lng) = r(i + 1).Offset(0, j)
Next

อยากให้ For ไล่ตั้งแต่ cell แรก จนถึง cell สุดท้ายที่มีข้อมูลใน row A
แต่ลองทำตาม code ด้านบนแล้วมัน error ค่ะ

[snasui]

wbk.Sheets("Sheet1").Range("A" & Rows.count).End(xlUp) หมายถึง เซลล์สุดท้ายที่มีข้อมูล หากหมายถึงเลขบรรทัดสุดท้ายที่มีข้อมูลสามารถเขียนเป็น wbk.Sheets("Sheet1").Range("A" & Rows.count).End(xlUp).Row

ดังนั้น Code จะได้เป็น

Code: Select all

For j = 1 To wbk.Sheets("Sheet1").Range("A" & Rows.count).End(xlUp).Row
      ReDim Preserve a(j, lng)
      a(j, lng) = r(i + 1).Offset(0, j)
Next

[nc_jajah]

พอรันวนไปรอบนึงแล้ว
ตรง

Code: Select all

ReDim Preserve a(j, lng)

ก็จะติด error ค่ะ

[snasui]

Array 2 มิติไม่สามารถที่จะเพิ่มขอบเขตของมิติแรกได้ ถ้าจะปรับต้องปรับที่ lng ไม่ใช่ที่ j ครับ

[nc_jajah]

โอเคค่ะ งั้นคงต้องเปลี่ยนวิธีการจัดเก็บข้อมูล

Code: Select all

Set rAll = .Range("A1", .Range("A" & rl).End(xlUp))

code นี้ ถ้าจะเปลี่ยนจากหาแนว Col เป็นแนว row ต้องแก้ตรงไหนหรอคะ

[nc_jajah]

สอบถามใหม่นะคะ เป็นตรงส่วนนี้ค่ะ

Code: Select all

If rRow = ("COMMODITY") Then
            IntRow = rRow.Row
            rRowWK = wbk.Sheets("Sheet1").Range("A" & Rows.count).End(xlUp)
            For j = 1 To rRowWK.Row
            	xxx   
            Next j
End If

คืออยากให้วน For ในแถว row ที่มีคำว่า COMMODITY อยู่ค่ะ
แต่ตอนนี้ For ฟิกค่าอยู่แถวแรกแล้วก็ค้นหาในแนว col ซึ่งไม่ได้ต้องการแบบนี้ค่ะ
กำหนด IntRow ให้เป็นเลขบรรทัดที่มี COMMODITY อยู่แล้ว จะนำ IntRow ไปใช้ใน code For ยังไงหรอคะ

[snasui]

ลองปรับ Code เป็นตามด้านล่างครับ

Code: Select all

If rRow = ("COMMODITY") Then
        intRow = rRow.Row
        With wbk.Worksheets("Sheet1")
            rRowWK = .Range(.Cells(intRow, "A"), _
                .Cells(intRow, Columns.Count).End(xlToLeft)).Columns.Count
        End With
        For j = 1 To rRowWK
           'xxx
        Next j
End If