如何用VB代码将A列每个单元格里所含有指定的字符复制到B列，要用VB代码

Question

FB011201033DV077-01450A6975440.41040AXBV C
FB011201033KN077-01450A6994936.81036AXBV D
如以下为在A列的信息，要将含有"FB12"字符的单元格复制到B列：
FB011201033KO077-01450A7014937.11028AXBV D
FB011201033KP077-01450A6994936.31046AXBV F
FB011201033KQ077-01450A7054936.81045AXBV D
FA121201033KR077-01450A7044936.61046AXBV D
FB031201033KS077-01450A6994936.81031AXBV D
FB031201033KT077-01450A7044936.51046AXBV D
FA121201033KU077-01450A7024936.51045AXBV D
FB181201033KV077-01450A7025138.01043AXBV F
FB181201033KX077-01450A7014936.41046AXBV D
FA121201033QZ077-01450A7525242.71025AXBV D
FA121201033R2077-01450A6754835.31025AXBV D
FB051201033R3077-01450A6904633.81025AXBV D
FB051201033R4077-01450A7035441.81023AXBV D
FA121201033R5077-01450A7135139.71023AXBV D
FB301201033R6077-01450A7514535.91033AXBV D
FB301201033R7077-01450A6965239.41020AXBV D
在2010 EXCEL里，使用VB代码完成将每单元格前四位含有"FB12"或"FA12"或"FB30"等指定字符的单元格信息复制到B列指定位置。

Answer 1

Sub CheckCopy()
Dim I As Long, U As Long, S As String
U = UsedRange.Rows.Count
For I = 1 To U
S = Range("A" & CStr(I)).Value
If InStr(UCase(a), "FB12") > 0 Then Range("B" & CStr(I)).Value = S
Next I
End Sub
此代码不区分大小写，如要区分去掉UCASE函数

追问

不行，不能使用!

追答

七零36二六零，附件发来是excel还是啥啊

追问

已经给你发送了7036260@qq.com

追答

Sub CheckCopy()
Dim I As Long, U As Long, S As String
U = activesheet.UsedRange.Rows.Count
For I = 1 To U
S = Range("A" & CStr(I)).Value
If InStr(UCase(S), "FB12") > 0 Then Range("B" & CStr(I)).Value = S
Next I
End Sub
哦，你给我的表格是2010版本的，不支持啊。不过我发现我给你的代码写错了，你改成上面这样就可以了
PS.我把工作表改成2007的修改了一下发给你了，注意查收。EXCEL要设置为启用宏，然后点击你设置的那个按钮就可以

追问

差不多了，还有一个问题就是复制的时候他们如果是间隔开的，最后复制到B列的间隔开的！我希望复制到后边的时候就直接对齐，没有间隔！

追答

那代码就这样：Sub CheckCopy()
Dim I As Long, U As Long, S As String, N As Long
U = ActiveSheet.UsedRange.Rows.Count
For I = 1 To U
S = Range("A" & CStr(I)).Value
If InStr(UCase(S), "FB12") > 0 Then
N = N + 1
Range("B" & CStr(N)).Value = S
End If
Next I
End Sub

Answer 2

Private Sub Command1_Click()

Set xlApp = New Excel.Application
Set xlApp = CreateObject("Excel.Application")
'On Error Resume Next
xlApp.Visible = True
Set xlBook = xlApp.Workbooks.Open(App.Path & "\1.xls")
b1 = 1
a1 = 1
Do While xlApp.Worksheets("Sheet1").Cells(a1, 1).Value <> ""
If InStr(xlApp.Worksheets("Sheet1").Cells(a1, 1).Value, "FB12") > 0 Then
xlApp.Worksheets("Sheet1").Cells(b1, 2).Value = xlApp.Worksheets("Sheet1").Cells(a1, 1).Value
b1 = b1 + 1
End If

a1 = a1 + 1
Loop
xlBook.Save
ActiveWorkbook.Close

xlApp.Quit
Set xlApp = Nothing
End Sub

追问

也没反应，不行！

追答

因为你给为的数里面没有 FB12,你把程序中的 FB12改成 FB，就看到了,这个图就是复制带FB 的
B列指定位置是什么位置？
问题补充后：
改 If InStr(xlApp.Worksheets("Sheet1").Cells(a1, 1).Value, "FB12") > 0 Then
为：
If InStr(xlApp.Worksheets("Sheet1").Cells(a1, 1).Value, "FB12") = 1 Or InStr(xlApp.Worksheets("Sheet1").Cells(a1, 1).Value, "FA12") = 1 Or InStr(xlApp.Worksheets("Sheet1").Cells(a1, 1).Value, "FB30") = 1 Then

Answer 3

A列是啥控件的还是EXCEL都不肯告诉大家

追问

A列是上边的信息，然后使用VB代码复制含有"FB12"到B列中，代码复制到别的表格也要能用！有问题我把附件发给各位。谢谢！

追答

A列是啥控件的还是EXCEL都不肯告诉大家