GBKEE

回復 10# luke
7# 的問題 是2003 以上的版本 使用End 屬性,如有計算  Rows.Count  或 Columns.Count 須指明它的父層物件
Sh(1).Rows.Count  或 Sh(1).Columns.Count
10# 的問題 修正用Find 取代 Match 找到 真正的字串 試試看

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim Sh(1 To 2) As Worksheet, Ar, E As Variant, xlCsv As String, xlPath As String
   
4.      Dim xi As Integer, xR As Integer, xF As Range, xlRowsCount As Long
   
5.     xlRowsCount = ActiveSheet.Rows.Count
   
6.     xlPath = ThisWorkbook.Path & "\"                                                '->修改為正確的檔案路徑
   
7.     Set Sh(1) = Workbooks.Open(xlPath & "test21.csv").Sheets(1)
   
8.     Set Sh(2) = Sh(1).Parent.Sheets.Add                                             '新增工作表作為 資料暫存
   
9.     Sh(1).Cells.Copy Sh(2).Cells(1)                                                 '複製 test21.csv 的資料                          '
   
10.     xlCsv = Dir(xlPath & "*.Csv")                                                   '尋找 *.Csv檔案
    
11.     Do While xlCsv <> "" And LCase(xlCsv) <> "test21.csv"
    
12.      With Workbooks.Open(xlPath & xlCsv).Sheets(1)
    
13.            Sh(2).Cells(xlRowsCount, 1).End(xlUp).Offset(2) = "[*" & xlCsv & "*]"
    
14.            .[a1].CurrentRegion.Copy Sh(2).Cells(xlRowsCount, 1).End(xlUp).Offset(1)  '複製 *.Csv的資料
    
15.            .Parent.Close 0
    
16.      End With
    
17.      xlCsv = Dir
    
18.     Loop
    
19.     Sh(1).Cells.Clear     'test21.csv.Sheets(1) 清除所有資料: 已備重新匯入排序後的*.Csv
    
20.     '*** 處裡 已匯入的 *.Csv*********
    
21.     With Sh(2)
    
22.         .Activate
    
23.         Ar = .Range("a:a").Value
    
24.         .Range("a:a").Replace "[*.*]", "=1/0"                                       '[*.Csv] 替代為錯誤值
    
25.         .Range("a:a").SpecialCells(xlCellTypeFormulas, xlErrors).Name = "檔名"      '將有錯誤值的儲存格 定義名稱
    
26.         .Range("a:a").Value = Ar                                                    '複原原來的值
    
27.         With .Columns(Columns.Count)
    
28.             [檔名].Copy .Cells(1)
    
29.             .Sort Key1:=.Range("a1"), Order1:=xlAscending, Header:=xlNo             '排序[檔名]
    
30.             xR = 1
    
31.             Do While .Cells(xR) <> ""                                               '匯入 "檔名"資料
    
32.                Set xF = .Parent.Columns(1).Find(.Cells(xR).Text, LookAT:=xlWhole)   '尋找 "檔名"
    
33.                 xi = Sh(1).Cells(xlRowsCount, 1).End(xlUp).Row
    
34.                 xi = IIf(xi = 1, 1, xi + 2)                                         '第二個[*.Csv]以後 須再往下位移到2列
    
35.                 xF.CurrentRegion.Copy Sh(1).Cells(xi, 1)
    
36.                 xi = Sh(1).Cells(xlRowsCount, 1).End(xlUp).Row
    
37.                 Sh(1).Cells(xi + 2, 1) = "[*div*]"
    
38.                 xR = xR + 1
    
39.             Loop
    
40.         End With
    
41.         Application.DisplayAlerts = False
    
42.         .Delete                                                                      '刪除資料暫存工作表
    
43.         Application.DisplayAlerts = True
    
44.     End With
    
45.     '*****測試 成功後 解除註解 可存檔
    
46.     'Sh(1).Parent.Close True
    
47. End Sub

複製代碼

luke

回復 9# Hsieh

     謝謝H大

    插入BB-1.csv和DD1.csv兩個檔所新建立的TEST21OK.csv,
    其檔尾處顯示[**]如附件
    TEST21OK.rar (369 Bytes)

下載次數: 4

2012-6-6 21:13

Hsieh

回復 12# luke

我測試OK阿

下載 (649.92 KB)

2012-6-6 21:22

luke

回復 11# GBKEE

     #11新修改程式測試後,
     排序情形變得很錯亂
     
     因檔名長和檔案很多
     我的想法是將檔案分別存檔後
     再依照排列順序
     結合一起
     如H超版於#9程式
     (但此程式採Chr(9)方式結合, 無法順利通過編譯)
     
     以上想法
     
    煩請指導

luke

回復 14# luke


    H大好

   #9 第54列Ar(0) = "[*div*]"不小心打成 Ar(0) = "[**]"
     
  謝謝回覆

GBKEE

回復 14# luke
排序情形變得很錯亂
可以看看嗎?

luke

回復 16# GBKEE


    謝謝版大

    存檔時如何把ANSI文字檔格式改成Unicode文字檔格式

    以下是用巨集錄製語法
    ActiveWorkbook.SaveAs Filename:="D:\TEST21OK.txt", _
    FileFormat:=xlUnicodeText, CreateBackup:=False

    應如何套到#9和#11程式?
   
    煩請指導 謝謝

GBKEE

回復 17# luke
Sh(1).Parent.Close True
Sh(1).Parent.SaveAs Filename:="D:\TEST21OK.txt", FileFormat:=xlUnicodeText, CreateBackup:=False

ActiveWorkbook.SaveAs fd & "結果\" & "TEST21OK.csv", 6
ActiveWorkbook.SaveAs  "D:\TEST21OK.txt", FileFormat:=xlUnicodeText, CreateBackup:=False

luke

回復 18# GBKEE

    謝謝版大

   文字檔存檔格式已解決.

   TEST21OK.csv檔案可否按照順序除去檔案首列名字[*檔名.csv*]和檔案結尾[*div*]和前一個空白列,
   僅留中間內容如附件所示的檔案,
    (或使用#9程式於拆檔轉存Unicode文字檔格式時, 不要帶入上述檔名和結尾)
      
    煩請指導 謝謝!
    TEST21C.rar (12.56 KB)

下載次數: 7

2012-6-7 21:19

luke

回復 18# GBKEE


    文件已上傳

     煩請指導 謝謝