我是Excel宏的新手。我有一个示例数据，我正在尝试编写一个应该执行多个操作的宏。在附加的Excel工作表中，您可以在单个网络＃上看到多个轨道＃，我想在相应的网络＃中放置单个轨道＃，并且在这样做时，应该在N和数字之间修剪空间以下
excel中的原始数据：
X33652 N 4230047169 2013/11/28()
X34704 N4230644769, N4230645169 2014/06/04/m/RB CLRD
X40110 N4230854369, N 4230846569 2014/06/04/B/No Mega
X40605 N 4320617605,N 4320617705,N 4320617805 14/06/12/MayS/CANCELLED/attached email
Ex：第3行的所需输出为
X40110 N4230854369 2014/06/04/B/No Mega
X40110 N4230846569 2014/06/04/B/No Mega
我有点没有帮助。任何帮助将不胜感激。
先谢谢。
答案 0 :(得分：0)
您需要将代码更改为
Dim i as Long, Temp1 as Str, Temp2() as Str, TempArr() as Str
For i = 1 to 100 ' For e.g. you need 100 rows
Temp1 = Trim(ActiveSheet.Range("A"&i))
TempArr = Split(Temp1," ")
Temp2 = Split(TempArr(1),",")
If Ubound(Temp2) = 1 Then
' i.e. There are 2 values in the second cell,
ActiveSheet.Range("B"&i) = TempArr(0) & " " Temp2(1) & " " & TempArr(2)
Else
' Do nothing
End if
ActiveSheet.Range("B"&i) = TempArr(0) & " " Temp2(0) & " " & TempArr(2)
Next i
效率极低，但会知道如何做到这一点。
答案 1 :(得分：0)
以下是其中一个解决方案：
先决条件：Sheet1包含原始数据（A列中的曲目＃，B列中要分割的数据和C列中的注释/日期），Sheet2将包含已处理的数据。
希望有所帮助。
代码（单击Alt + F11，单击插入/模块，将代码粘贴到插入的模块中）：
Sub test()
Dim a As String, g As String, k As String, l As String
Dim b As Long, c As Long, d As Integer, e As Integer, f As Long, h As Integer, i As Integer, j As Long
b = 1
j = 1
While IsEmpty(Sheet1.Range("A" & b)) = False 'does not check if exceeding excel row limit
b = b + 1
Wend
For c = 1 To b 'Or "2 to b" if data has headers (if first row contains column names)
a = Sheet1.Range("B" & c) 'If column B contains the data to split
k = Sheet1.Range("A" & c) 'network #
l = Sheet1.Range("C" & c) 'date or comment
d = Len(a)
h = 0
For e = 1 To d
If Mid(a, e, 1) = "," Or e = d Then
If h = 0 Then
If e = d Then
i = e
Else
i = e - 1
End If
g = Mid(a, 1, i)
While IsEmpty(Sheet2.Range("B" & j)) = False 'does not check if exceeding excel row limit
j = j + 1
Wend
Sheet2.Range("A" & j) = k
Sheet2.Range("B" & j) = g
Sheet2.Range("C" & j) = l
Else
If e = d Then
g = Mid(a, i + 2, e - i - 1)
Else
g = Mid(a, i + 2, e - i - 2)
End If
While IsEmpty(Sheet2.Range("B" & j)) = False 'does not check if exceeding excel row limit
j = j + 1
Wend
Sheet2.Range("A" & j) = k
Sheet2.Range("B" & j) = g
Sheet2.Range("C" & j) = l
i = e - 1
End If
h = 1
End If
Next e
Next c
Dim m As Long, o As Integer
m = 1 'Or 2 if top row contains headings
Dim n As String
While IsEmpty(Sheet2.Range("B" & m)) = False
Sheet2.Range("B" & m) = Trim(Sheet2.Range("B" & m)) 'trim
n = Sheet2.Range("B" & m)
For o = 1 To Len(n)
If Mid(n, o, 1) = " " Then n = Left(n, 1) & Right(n, Len(n) - 2) 'remove single space
Next o
Sheet2.Range("B" & m) = n
m = m + 1
Wend
End Sub
尝试此代码（根据评论更新）：
Sub test()
Dim srow As Integer
srow = MsgBox("Does the first row contain data headers (column names)?", vbYesNo + vbQuestion, "First row selection")
If srow = 6 Then
srow = srow - 4
Else
srow = srow - 6
End If
Dim a As String, g As String, k(16383) As String, l(16383) As String
Dim b As Long, c As Long, d As Integer, e As Integer, f As Long, h As Integer, i As Integer, j As Long
b = srow
j = srow
While IsEmpty(Sheet1.Range("A" & b)) = False And b < 1048576
b = b + 1
Wend
b = b - 1
If srow > b Then MsgBox "No entries to analyze!", vbInformation, "Attention!": Exit Sub
Dim spli As String
INPU:
spli = InputBox("Please, enter the Letter of the column, which contains the data to split", "Define split column")
If Len(spli) > 3 Or Len(spli) < 1 Then MsgBox "Please, enter a valid Letter of a column", vbCritical + vbOKOnly, "Error!": GoTo INPU
Dim letc As Integer
For letc = 65 To 122
If letc <> 91 And letc <> 92 And letc <> 93 And letc <> 94 And letc <> 95 And letc <> 96 Then
If Left(spli, 1) = Chr(letc) Then Exit For
If letc = 122 And Left(spli, 1) <> Chr(letc) Then MsgBox "Please, enter a valid Letter of a column", vbCritical + vbOKOnly, "Error!": GoTo INPU
End If
Next letc
If Len(spli) > 1 Then
For letc = 65 To 122
If letc <> 91 And letc <> 92 And letc <> 93 And letc <> 94 And letc <> 95 And letc <> 96 Then
If Mid(spli, 2, 1) = Chr(letc) Then Exit For
If letc = 122 And Mid(spli, 2, 1) <> Chr(letc) Then MsgBox "Please, enter a valid Letter of a column", vbCritical + vbOKOnly, "Error!": GoTo INPU
End If
Next letc
End If
If Len(spli) = 3 Then
For letc = 65 To 122
If letc <> 91 And letc <> 92 And letc <> 93 And letc <> 94 And letc <> 95 And letc <> 96 Then
If Right(spli, 1) = Chr(letc) Then Exit For
If letc = 122 And Right(spli, 1) <> Chr(letc) Then MsgBox "Please, enter a valid Letter of a column", vbCritical + vbOKOnly, "Error!": GoTo INPU
End If
Next letc
If Left(spli, 1) = "Y" Or Left(spli, 1) = "Z" Or Left(spli, 1) = "y" Or Left(spli, 1) = "z" Then
MsgBox "Please, enter a valid Letter of a column", vbCritical + vbOKOnly, "Error!": GoTo INPU
End If
If Left(spli, 1) = "X" Or Left(spli, 1) = "x" Then
If Asc(Mid(spli, 2, 1)) < 65 Or (Asc(Mid(spli, 2, 1)) > 70 And Asc(Mid(spli, 2, 1)) < 97) Or Asc(Mid(spli, 2, 1)) > 102 Then
MsgBox "Please, enter a valid Letter of a column", vbCritical + vbOKOnly, "Error!": GoTo INPU
End If
If Mid(spli, 2, 1) = "F" Or Mid(spli, 2, 1) = "f" Then
If Asc(Right(spli, 1)) < 65 Or (Asc(Right(spli, 1)) > 68 And Asc(Right(spli, 1)) < 97) Or Asc(Right(spli, 1)) > 100 Then
MsgBox "Please, enter a valid Letter of a column", vbCritical + vbOKOnly, "Error!": GoTo INPU
End If
End If
End If
End If
Dim coll As Long, colr As Long, coun As Long
RECL:
coll = InputBox("How many columns to the left of the split data column would you like to copy?", "Left Columns")
If Sheet1.Range(spli & srow).Column - coll < 1 Then
MsgBox "Wrong number of columns indicated", vbExclamation + vbOKOnly, "Error!"
GoTo RECL
End If
RECR:
colr = InputBox("How many columns to the right of the split data column would you like to copy?", "Right Columns")
If Sheet1.Range(spli & srow).Column + colr > 16384 Then
MsgBox "Wrong number of columns indicated", vbExclamation + vbOKOnly, "Error!"
GoTo RECR
End If
For c = srow To b
a = Sheet1.Range(spli & c)
For coun = 0 To coll - 1
k(coun) = Sheet1.Cells(c, Sheet1.Range(spli & c).Column - 1 - coun)
Next coun
For coun = 0 To colr - 1
l(coun) = Sheet1.Cells(c, Sheet1.Range(spli & c).Column + 1 + coun)
Next coun
d = Len(a)
h = 0
For e = 1 To d
If Mid(a, e, 1) = "," Or Mid(a, e, 1) = "/" Or e = d Then
If h = 0 Then
If e = d Then
i = e
Else
i = e - 1
End If
g = Mid(a, 1, i)
While IsEmpty(Sheet2.Range(spli & j)) = False And j < 1048576
j = j + 1
Wend
For coun = 0 To coll - 1
Sheet2.Cells(j, Sheet1.Range(spli & c).Column - 1 - coun) = k(coun)
Next coun
Sheet2.Range(spli & j) = g
For coun = 0 To colr - 1
Sheet2.Cells(j, Sheet1.Range(spli & c).Column + 1 + coun) = l(coun)
Next coun
Else
If e = d Then
g = Mid(a, i + 2, e - i - 1)
Else
g = Mid(a, i + 2, e - i - 2)
End If
While IsEmpty(Sheet2.Range(spli & j)) = False And j < 1048576
j = j + 1
Wend
For coun = 0 To coll - 1
Sheet2.Cells(j, Sheet1.Range(spli & c).Column - 1 - coun) = k(coun)
Next coun
Sheet2.Range(spli & j) = g
For coun = 0 To colr - 1
Sheet2.Cells(j, Sheet1.Range(spli & c).Column + 1 + coun) = l(coun)
Next coun
i = e - 1
End If
h = 1
End If
Next e
Next c
Dim m As Long, o As Integer
m = srow
Dim n As String
While IsEmpty(Sheet2.Range(spli & m)) = False
Sheet2.Range(spli & m) = Trim(Sheet2.Range(spli & m)) 'trim
n = Sheet2.Range(spli & m)
For o = 1 To Len(n)
If Mid(n, o, 1) = " " Then n = Left(n, 1) & Right(n, Len(n) - 2) 'remove single space
Next o
Sheet2.Range(spli & m) = n
m = m + 1
Wend
End Sub