vb宏命令把excel隨機轉換成n個檔案夾,每個檔案夾有10個txt檔案。可以做到嗎?
下面是把excel全部轉換在一個檔案夾里例子。
Dim intLastRow, arr, intLoop
intLastRow = Cells(Rows.Count, 1).End(xlUp).Row
arr = Range("a1:b" & intLastRow)
For intLoop = 1 To UBound(arr)
Open "D:\ceshi\" & arr(intLoop, 1) & ".txt" For Output As #1
Print #1, arr(intLoop, 1)
Close #1
Next
uj5u.com熱心網友回復:
這個宏命令滿足不了我的要求,求大神幫忙解答下啊uj5u.com熱心網友回復:
可以參考我給的例子,幫忙改下。就是分類到多個檔案夾內!!!!!!!!!!!!1uj5u.com熱心網友回復:
Option Explicit
Function RandFolder(ByVal Count As Long) As String()
Dim a() As String
Dim i As Long
Dim j As Long
Dim t As String
'生成目錄'
ReDim a(Count - 1)
For i = 0 To Count - 1
a(i) = "D:\ceshi\" & i & "\"
If LenB(Dir(a(i), vbDirectory)) = 0 Then
MkDir a(i)
End If
Next
'洗牌'
Randomize
For i = 0 To Count - 1
j = Int(Rnd() * Count)
t = a(i)
a(i) = a(j)
a(j) = t
Next
RandFolder = a
End Function
Dim intLastRow, arr, intLoop
Dim lFolderCount As Long
Dim aFolders() As String
intLastRow = Cells(Rows.Count, 1).End(xlUp).Row
arr = Range("a1:b" & intLastRow)
lFolderCount = (UBound(arr) - 1) \ 10
aFolders = RandFolder(lFolderCount)
For intLoop = 1 To UBound(arr)
'每10個檔案歸到一個目錄中'
Open aFolders((intLoop - 1) \ 10) & arr(intLoop, 1) & ".txt" For Output As #1
Print #1, arr(intLoop, 1)
Close #1
Next
轉載請註明出處,本文鏈接:https://www.uj5u.com/gongcheng/84121.html
標籤:VBA
