如何从单个单元格中获取特定值并将其放入Excel VBA中的不同单元格中

我需要做1000个以上的单元格,读取特定的数据,并使用Excel VBA放在各自的单元格下。

例:

Name Age No. .. . abc 14 123454 ------>this from single cell 

其中包含如Name: abc,Age: 14, No: 123454

这应该是一个好的开始:

 Sub Split_N_Copy() Dim InFo() Dim InfSplit() As String InFo = ActiveSheet.Cells.UsedRange.Value2 Sheets.Add after:=Sheets(Sheets.Count) For i = LBound(InFo, 1) To UBound(InFo, 1) 'Here I put InFo(i,1), "1" if we take the first column InfSplit = Split(InFo(i,1), ",") For k = LBound(InfSplit) To UBound(InfSplit) Sheets(Sheets.Count).Cells(i + 1, k + 1) = InfSplit(k) Next k Next i End Sub 

我写了一个基于分隔符的函数,并且:对于等号,search第一行包含头部的一系列数据:

 Function UpdateSheet(allData As String, inRange As Range) Dim strData() As String Dim i As Long, lastRow As Long Dim columnName As String, value As String Dim cell As Range 'You need to change this to finding last row like this answer: 'http://stackoverflow.com/a/15375099/4519059 lastRow = 2 strData = Split(allData, ",") For i = LBound(strData) To UBound(strData) columnName = Trim(Left(strData(i), InStr(1, strData(i), ":") - 1)) value = Trim(Mid(strData(i), InStr(1, strData(i), ":") + 1)) For Each cell In inRange If cell.Cells(1, 1).Rows(1).Row = 1 Then If cell.Cells(1, 1).value Like "*" & columnName & "*" Then inRange.Worksheet.Cells(lastRow, cell.Columns(1).Column).value = value End If End If Next Next End Function 

现在你可以使用这样的function:

 Sub update() Call UpdateSheet("Name: abc,Age: 14, No: 123454", Sheets(1).UsedRange) End Sub 
 Private Sub CommandButton1_Click() lastRow = Sheet1.Cells(Sheet1.Rows.Count, "G").End(xlUp).Row Dim i As Integer i = 2 For i = 2 To lastRow Dim GetData As String GetData = Sheet1.Cells(i, 7) Call UpdateSheet(GetData, Sheets(1).UsedRange, i) Next End Sub Function UpdateSheet(allData As String, inRange As Range, rowno As Integer) Dim strData() As String Dim i As Long, lastRow As Long Dim columnName As String, value As String Dim cell As Range strData = Split(allData, ",") For i = LBound(strData) To UBound(strData) Value1 = Trim(Mid(strData(i), InStr(1, strData(i), ":") + 1)) If Value1 <> "" Then columnName = Trim(Left(strData(i), InStr(1, strData(i), ":") - 1)) value = Trim(Mid(strData(i), InStr(1, strData(i), ":") + 1)) For Each cell In inRange If cell.Cells(1, 1).Rows(1).Row = 1 Then If cell.Cells(1, 1).value Like "*" & columnName & "*" Then inRange.Worksheet.Cells(rowno, cell.Columns(1).Column).value = value End If End If Next End If Next End Function