2010-05-28 2 views

ответ

0

У меня нет Excel передо мной, но я думаю, что этот код примерно то, что вам нужно, дать или принять некоторые синтаксические ошибки. Он должен писать каждый столбец в отдельный файл, причем каждая ячейка находится в другой строке. Он будет работать для произвольной высоты столбцов, хотя количество столбцов находится в переменной (пока).

dim fso as FileSystemObject 
dim ts as TextStream 
dim i as Integer 
dim myCell as Range 

set fso = FileSystemObject 

for i = 0 to TotalColumnNumber 
    ' last argument, True, says to create the text file if it doesnt exist, which is 
    ' good for us in this case 
    Set ts = fso.OpenTextFile("column_" & i, ForWriting, True) 

    ' set mycell to the first cell in the ith column 
    set myCell = SheetName.cells(1,i) 

    ' continue looping down the column until you reach a blank cell 
    ' writing each cell value as you go 
    do until mycell.value = "" 
     ts.writeline mycell.value 
     set myCell = myCell.offset(1,0) 
    loop 

    ts.close 
next 

set ts = nothing 
set fso = nothing 

Позвольте мне знать, если это помогает или нет, я беру можно еще раз посмотреть позже, если вы хотите

0

Возможно

Dim cn As Object 
Dim rs As Object 
Dim strFile As String 
Dim strCon As String 
Dim strSQL As String 
Dim i As Integer 

''This is not the best way to refer to the workbook 
''you want, but it is very conveient for notes 
''It is probably best to use the name of the workbook. 

strFile = ActiveWorkbook.FullName 

''Note that if HDR=No, F1,F2 etc are used for column names, 
''if HDR=Yes, the names in the first row of the range 
''can be used. 
''This is the Jet 4 connection string, you can get more 
''here : http://www.connectionstrings.com/excel 

strCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strFile _ 
    & ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"";" 

''Late binding, so no reference is needed 

Set cn = CreateObject("ADODB.Connection") 
Set rs = CreateObject("ADODB.Recordset") 

cn.Open strCon 

''WHERE 1=1 = headers only, note hdr=yes above 

strSQL = "SELECT * " _ 
     & "FROM [Sheet1$] " _ 
     & "WHERE 1=1" 


''Open the recordset for more processing 
''Cursor Type: 3, adOpenStatic 
''Lock Type: 3, adLockOptimistic 
''Not everything can be done with every cirsor type and 
''lock type. See http://www.w3schools.com/ado/met_rs_open.asp 

rs.Open strSQL, cn, 3, 3 

''Output including nulls. Note that this will fail if the file 
''exists. 

For i = 0 To rs.Fields.Count - 1 
    strSQL = "SELECT [" & rs.Fields(i).Name & "] " _ 
    & "INTO [Text;HDR=YES;FMT=Delimited;IMEX=2;DATABASE=C:\Docs\]." _ 
    & rs.Fields(i).Name & ".CSV " _ 
    & "FROM [Sheet1$] " 

    ''To skip nulls and empty cells, add a WHERE statement 
    ''& "WHERE Trim([" & rs.Fields(i).Name & "] & '')<>'' " 

    cn.Execute strSQL 
Next 


''Tidy up 
rs.Close 
Set rs = Nothing 
cn.Close 
Set cn = Nothing 
0

Очень быстрая линия, чтобы вы начали ...

for i = 1 to 100 
    open "file" & i & ".txt" as #1 
    for each c in columns(i).cells 
     print #1, c.value 
    next c 
    close #1 
next i 
Смежные вопросы