VB-宏分裂兩個字符串，並將它們作爲新行和修剪功能插入

-3

我是一種新的Excel宏。我有一個示例數據，我試圖編寫一個應該執行多個操作的宏。在附加的excel表格中，您可以看到多個單個網絡＃上的＃號，我希望將相應的網絡＃放置在相應的網絡＃上，並且在這樣做時，空格應該在N和後面的數字之間進行修整。VB-宏分裂兩個字符串，並將它們作爲新行和修剪功能插入

在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

例：第3行所需的輸出是

X40110 N4230854369    2014/06/04/B/No Mega 
X40110 N4230846569    2014/06/04/B/No Mega

我有點卡住沒有幫助。任何幫助將不勝感激。

在此先感謝。

來源

2014-07-09 Emily

對不起，這是一個錯字。其VBA – Emily

請張貼您的代碼在哪裏堅持 – hnk

我試圖修剪值，但我無法繼續，因爲它顯示語法錯誤。正如我之前告訴過的，我只是一個宏的新手:( Private Sub CommandButton1_Click（） Range（「A1：A」）。Value = Replace $（trim（「A：A」），「」，「」） End Sub – Emily

這裏是解決方案之一：

先決條件：Sheet 1中包含的原始數據（磁道＃列A，數據在列B和C列評論/日期分裂），Sheet 2中將包含處理的數據。

希望有所幫助。

代碼（點擊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

來源

2014-07-09 17:47:08 StandardDeviation

太謝謝你了！我真的很感激它:) 但它只處理三列<我只是舉了一個三列的例子，但我的實際數據有很多列。請幫助 – Emily

許多列與數據拆分？或許多列與處理的數據一起傳輸？ – StandardDeviation

許多列與處理的數據一起傳輸 – Emily

您需要更改您的代碼

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

這是非常低效的，但會給一個想法如何可以做到。

來源

2014-07-09 15:42:40 hnk

謝謝。這是爲了修正值，但我需要拆分數值到行然後修剪它。我該怎麼做 – Emily

你在找fo fo作爲輸出的一行中有兩行？ – hnk

我正在尋找2行或3行（基於數據）輸入的單行輸入 – Emily

VB-宏分裂兩個字符串，並將它們作爲新行和修剪功能插入

回答

相關問題