VBA：如何将一列完整字典转换为每个字母一列？

我有一个完整的字典。 所有的字（360 000）都在一列中。

我想要列B的所有单词以“a”开始，列C以b开始的所有单词…

我正在尝试做一个循环或什么…但是…它太长了。

有小费吗？ 还是有人已经做这个vbamacros？

韩国社交协会，

斯特凡。

Answer 1

如果我们从以下开始：

运行这个简短的macros：

Sub SeparateData() Dim N As Long, i As Long, NewCol As Long Dim M As Long N = Cells(Rows.Count, 1).End(xlUp).Row For i = 1 To N NewCol = Asc(UCase(Left(Cells(i, 1).Value, 1))) - 63 If Cells(1, NewCol).Value = "" Then M = 1 Else M = Cells(Rows.Count, NewCol).End(xlUp).Row + 1 End If Cells(M, NewCol).Value = Cells(i, 1).Value Next i End Sub 

会产生：

注意：

您可能需要向NewCol计算行添加一些错误捕获逻辑。

编辑＃1：

这个版本可能会稍微快一点：

 Sub SeparateDataFaster() Dim N As Long, i As Long, NewCol As Long Dim M As Long, time1 As Date, time2 As Date N = Cells(Rows.Count, 1).End(xlUp).Row time1 = Now Application.ScreenUpdating = False Application.Calculation = xlCalculationManual For i = 1 To N NewCol = Asc(UCase(Left(Cells(i, 1).Value, 1))) - 63 If Cells(1, NewCol).Value = "" Then M = 1 Else M = Cells(Rows.Count, NewCol).End(xlUp).Row + 1 End If Cells(M, NewCol).Value = Cells(i, 1).Value Next i Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic time2 = Now MsgBox time1 & vbCrLf & time2 End Sub 

Answer 2

你可以尝试这样的事情。 360k的logging大约需要20秒。

要创buildtesting数据我使用这个子：

 Sub FillTestData() Dim t As Long Dim lng As Integer Dim text As String 'Start = Timer For t = 1 To 360000 text = vbNullString lng = 5 * Rnd + 10 For i = 1 To lng Randomize text = text & Chr(Int((26 * Rnd) + 65)) Next i Cells(t, 1) = text Next t 'Debug.Print Timer - Start End Sub 

并分开：

 Sub sep() 'Start = Timer Dim ArrWords() As Variant Dim Row_ As Long LastRow = Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row ArrWords = Range("A1:A" & LastRow) 'all data from column A to array For i = 65 To 90 ' from A to Z Row_ = 1 For j = LBound(ArrWords, 1) To UBound(ArrWords, 1) If Asc(UCase(ArrWords(j, 1))) = i Then Cells(Row_, i - 63) = ArrWords(j, 1) Row_ = Row_ + 1 End If Next j Next i 'other than a[A]-z[Z] Row_ = 1 For j = LBound(ArrWords, 1) To UBound(ArrWords, 1) If Asc(UCase(ArrWords(j, 1))) < 65 Or Asc(UCase(ArrWords(j, 1))) > 90 Then Cells(Row_, 28) = ArrWords(j, 1) Row_ = Row_ + 1 End If Next j 'Debug.Print Timer - Start End Sub 

Answer 3

你可以尝试：

 For i = 1 To Cells(Rows.count, 1).End(xlUp).Row Range(UCase(Left$(Cells(i, 1).Text, 1)) & Rows.count).Offset(0, 1).End(xlUp).Offset(IIf(Range(UCase(Left$(Cells(i, _ 1).Text, 1)) & Rows.count).Offset(0, 1).End(xlUp).Row = 1, 0, 1), 0).Value = Cells(i, 1).Text Next i 

这只是通过执行以下操作使用单词的第一个字母来构build目标地址：

• 循环遍历A列中的每个单元格
• 获取该单元格的第一个字母并将其转换为大写
• find该字母开头的最后一个单元格
• 向右移动1列
• 直到我们碰到最后一行数据
• 如果最后一行不是第1行，则向下移动另一行（下一个空白单元格）
• 给这个单元格的值与我们正在评估的列A中的单元格相同

Answer 4

您可以input以下公式：

对于B中的字母A列： =IF(UPPER(LEFT(A1,1))="A",A1,"")

对于C列中的字母B： =IF(UPPER(LEFT(A1,1))="B",A1,"")

对字母C，D等重复相同的操作。