返回列表下一主題上一主題發帖

取list 不知如何可進階一下, ??

tomking

中學生 Rank: 2

帖子: 34
主題: 10
精華: 0
積分: 56
點名: 0
作業系統: WINDOWS10
軟體版本: office 2016
閱讀權限: 20
性別: 男
註冊時間: 2011-4-17
最後登錄: 2020-7-16

1^# 跳轉到 » 正序看帖

打印

字體大小: tT

發表於 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