標題: 取list 不知如何可進階一下, ?? [打印本頁]

---

作者: tomking    時間: 2011-4-25 18:51     標題: 取list 不知如何可進階一下, ??

dear..
以下, ?之旁,,指令,,,不知,如何.可進階一下,
if  a2 為bbb ..  ThisWorkbook.Sheets("List").[a2].Offset(lngCurrRow) = wbCurr.Sheets(1).[a2]
         為ccc..     ThisWorkbook.Sheets("List").[a2].Offset(lngCurrRow) = wbCurr.Sheets(1).[a5]

不知,如何做, -->

目的:取list 之文字檔,排列不同,有好幾種:



Sub Button1_Click()
    Dim fso As Object
    Dim objFile As Object
    Dim objFolder As Object
    Dim wbCurr As Workbook
    ThisWorkbook.Sheets("List").Select
    Application.ScreenUpdating = False
    Set fso = CreateObject("Scripting.FileSystemObject")
   
    Cells.Select
    Selection.Clear
    [a1].Select
    Dim lngCurrRow As Long
    Set objFolder = fso.GetFolder(ThisWorkbook.Path)
    lngCurrRow = 0

    For Each objFile In objFolder.Files
        If Right(objFile.Name, 4) = ".txt" Then
            Set wbCurr = Application.Workbooks.Open(Filename:=objFile.Path)
    ?        If wbCurr.Sheets(1).[a1] <> "" Then
      ?          ThisWorkbook.Sheets("List").[a2].Offset(lngCurrRow) = wbCurr.Sheets(1).[a1]
      ?   ThisWorkbook.Sheets("List").[b2].Offset(lngCurrRow) = wbCurr.Sheets(1).[a2]

        ?                        lngCurrRow = lngCurrRow + 1
          ?  End If            wbCurr.Close (False)
        End If
        Set wbCurr = Nothing
    Next

---

作者: tomking    時間: 2011-4-25 22:49

已搞定...ＴＨＳ。　

---

歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)