Excel VBA – 将一个单元格拆分为1000个，并将其复制到不同的单元格中

我想知道是否有一种方法可以将6000个单词分成1000个单词。 例如，单元格C1中的1000个单词，然后C2中的下一个1000个单词等等。

这是我到目前为止的代码。

该代码（单元格C1）的输出应该被拆分，C6有1000个字，C7有1000个字，依此类推，直到没有更多的单词可用。

先谢谢你！

Option Explicit Option Base 1 Dim dStr As String, aCell As Range Dim cet, i As Long Sub countWords() Application.ScreenUpdating = False Dim iniWords As Long, lWords As Long Dim wK As Worksheet On Error GoTo Err Set wK = ActiveSheet dStr = Join(WorksheetFunction.Transpose(wK.Range("A1:A" & wK.Range("A" & Rows.Count).End(xlUp).Row).Value), " ") 'iniWords = WorksheetFunction.CountA(wK.Range("A1:A" & wK.Rows.Count)) cet = Split(dStr, " ") iniWords = UBound(cet) wK.Range("A1:A" & wK.Range("A" & Rows.Count).End(xlUp).Row).RemoveDuplicates Columns:=1, Header:=xlNo 'lWords = WorksheetFunction.CountA(wK.Range("A1:A" & wK.Rows.Count)) dStr = Join(WorksheetFunction.Transpose(wK.Range("A1:A" & wK.Range("A" & Rows.Count).End(xlUp).Row).Value), " ") cet = Split(dStr, " ") dStr = "" For i = LBound(cet) To UBound(cet) If Trim(cet(i)) <> "" And InStr(dStr, Trim(cet(i))) = 0 Then dStr = Trim(dStr) & " " & Trim(cet(i)) End If Next i dStr = Trim(dStr) cet = Split(dStr, " ") lWords = UBound(cet) wK.Range("C1") = dStr Application.ScreenUpdating = True MsgBox "Words: " & iniWords & vbNewLine & _ "Removed duplicates " & iniWords - lWords & vbNewLine & _ "Remaining Words " & lWords Exit Sub Err: MsgBox "There is no data in row A" End Sub 

Answer 1

你可以使用这个：

 Option Explicit Sub main() Const NWORDS As Long = 100 '<--| it's the number of words you want each cell to be written with. change it to your needs Dim strng As String Dim rowOffset As Long With Range("C1") strng = .Value rowOffset = 5 '<--| point to C7 at the first iteration Do strng = Replace(strng, " ", "|", , NWORDS) '<--| "mark" the first NWORDS with a different separator (be sure pipe ("|") is not a character you can have in your words) .Offset(rowOffset).Value = Replace(Left(strng, InStrRev(strng, "|") - 1), "|", " ") '<--| write first NWORDS words in current 'rowoffset' cell strng = Right(strng, Len(strng) - InStrRev(strng, "|")) rowOffset = rowOffset + 1 '<--| update row offset Loop While UBound(Split(strng, " ")) > NWORDS - 1 .Offset(rowOffset).Value = strng End With End Sub