用另一列中的值填充列(如果语句)

我目前有一个VBScript,接受一个Excel文档,并重新格式化到另一个更有组织的Excel文档。 此代码还必须查看CATALOG列(“B1”)的值,并且只在值的起始处以“EDASM”,“EDBSM”等开头的情况下,才将其放在图纸列(“M1”移动时,必须删除“ED”前缀。

例如,产品目录号EDF12-01114将导致图纸栏中没有任何内容,但是对于EDSM10265,我们需要将SM10265放置在图纸栏中(放下“ED”)。

我到目前为止所做的是这个,甚至不完整:

Set objRange = objWorkSheet.Range("M1").EntireColumn IF objWorkSheet.Range("B1").Row = "EDF*" THEN 'Maybe correct-ish? Not sure about syntax objRange = Null Else objRange = ("B1") 'Totally an awful guess, but I have no clue what to put here End If 

我曾经见过类似的代码有循环和什么,但他们似乎没有做我需要做的事情。 谢谢!

编辑:目前的代码基于布鲁斯韦恩的。 仍然不会返回任何Excel数据表的绘图列,但它看起来更接近…

 Sub move_Text() Dim lastRow, nextRow, cel , rng lastRow = Cells(Rows.Count, 2).End(xlUp).Row ' Since your Col. B is the data, let's find that column's last row Set rng = Range(Cells(1, 2), Cells(lastRow, 2)) nextRow = 1 For Each cel In rng If Left(cel.Value, 3) <> "EDF" Then Cells(nextRow, 13).Value = Mid(cel.Value, 3, Len(cel.Value) - 2) nextRow = nextRow + 1 End If Next End Sub 

另一个编辑! 目录列现在是“C”,而不是“B”。 另外,我有两个标题行,所以第一个目录号位于“C3”中。

再次感谢! 我们正在接近。

以下是Google云端硬盘文件: https : //drive.google.com/folderview?id=0B2MeeQ3BKptFYnZfQWpwbTJxMm8&usp=sharing

重要记得

在Google云端硬盘文件中: TestScript.vbs是所有代码所在的文件。 脚本运行时,selectExcelImport 。 这应该返回FinalDocument

我想这是你在找什么:

 Sub move_Text() Dim lastRow, nextRow, cel, rng 'get last row with data in Column B lastRow = Cells(Rows.Count, "B").End(xlUp).Row 'set your range starting from Cell B2 Set rng = Range("B2:B" & lastRow) 'loop through all the cells in the range to check for "EDF" and "ED" For Each cel In rng 'below condition is to check if the string starts with "EDF" If cel.Value Like "EDF*" Then 'do nothing 'below condition is to check if the string starts with "ED" ElseIf cel.Value Like "ED*" Then 'drop first two characters of cell's value and write in Column M cel.Offset(0, 11).Value = Right(cel.Value, Len(cel.Value) - 2) 'else condition will be executed when none of the above two conditions are satisfied 'else condition is based on the link mentioned in your question that will handle words like "ELECTRICAL BOX" Else 'write cell's value in Column Q cel.Offset(0, 11).Value = cel.Value End If Next End Sub 

编辑:对于VBScirpt ________________________________________________________________________________

 Sub Demo() Dim lastRow, nextRow, cel, rng Const xlShiftToRight = -4161 Const xlUp = -4162 Const xlValues = -4163 Const xlWhole = 1 Const xlPrevious = 2 With objWorksheet 'get last row with data in Column B lastRow = .Cells(.Rows.Count, "C").End(xlUp).Row 'set your range starting from Cell B2 Set rng = .Range("C2:C" & lastRow) End With 'loop through all the cells in the range to check for "EDF" and "ED" For Each cel In rng 'below condition is to check if the string starts with "EDF" If InStr(1, cel.Value, "EDF", 1) = 1 Then 'do nothing 'below condition is to check if the string starts with "ED" ElseIf InStr(1, cel.Value, "ED", 1) = 1 Then 'drop first two characters of cell's value and write in Column M cel.Offset(0, 10).Value = Right(cel.Value, Len(cel.Value) - 2) 'else condition will be executed when none of the above two conditions are satisfied 'else condition is based on the link mentioned in your question that will handle words like "ELECTRICAL BOX" Else 'write cell's value in Column M cel.Offset(0, 10).Value = cel.Value End If Next End Sub 

这个工作怎么样?

 Sub move_Text() Dim lastRow&, nextRow& Dim cel As Range, rng As Range lastRow = Cells(Rows.Count, 2).End(xlUp).Row ' Since your Col. B is the data, let's find that column's last row Set rng = Range(Cells(1, 2), Cells(lastRow, 2)) nextRow = 1 For Each cel In rng If Left(cel.Value, 2) = "ED" Then Cells(nextRow, 13).Value = Mid(cel.Value, 3, Len(cel.Value) - 2) nextRow = nextRow + 1 End If Next cel End Sub 

它将范围设置为您的列B,从第1行到最后一行。 然后,循环遍历每个单元格,检查左边的两个字母。 如果“ED”,然后移动数据,但脱掉“ED”。

编辑:刚刚意识到你正在使用VBScript。 从声明中删除“ as Range和“ & ”,所以它只是Dim lastRow, nextRow, cel, rng

如果满足您的条件,则会将列B中的值(减去ED前缀)复制到列M.

 Sub move_Text() Dim lastRow , i lastRow = Cells(Rows.Count, 3).End(xlUp).Row For i = 3 To lastRow If Left(Cells(i, 3), 2) = "ED" And Not (Left(Cells(i, 3), 3) = "EDF") Then Cells(i, 13).Value = Right(Cells(i, 3, Len(Cells(i, 3)) - 2) End If Next End Sub 

为什么不使用一些Excel的公式来加速整个事情:

 Sub My_Amazing_Solution () Range("M3").FormulaR1C1 = "=IF(TRIM(LEFT(RC[-10],2))=""ED"",RIGHT(TRIM(RC[-10]),LEN(RC[-10])-2),"""")" Range("M3").AutoFill Destination:=Range("M3:M" & Range("C1048576").End(xlUp).Row), Type:=xlFillDefault Application.Wait Now + TimeValue("00:00:03") Range("M3:M" & Range("C1048576").End(xlUp).Row).Copy Range("M3").PasteSpecial xlPasteValues End sub 

这应该为你做!