使用来自另一列的值填写列if语句

I currently have a VBScript that takes in an Excel document and re-formats it into another Excel document that's more organized. This code must also look at the values of the CATALOG column ("B1") and place it in the Drawings column ("M1") ONLY if the beginning of the value starts with "EDASM", "EDBSM" etc., yet the "ED" prefix must be eliminated when it's moved.

我目前有一个VBScript,它接收一个Excel文档并将其重新格式化为另一个更有条理的Excel文档。如果值的开头以“EDASM”,“EDBSM”等开头,此代码还必须查看CATALOG列(“B1”)的值并将其置于图纸列(“M1”)中,但是移动时必须删除“ED”前缀。

For example, Catalog number EDF12-01114 would result in nothing being placed in the drawings column, but with EDSM10265, we would need SM10265 to be placed in the drawings column (drop the "ED").

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

All I've got so far is this, which isn't even complete:

到目前为止我所有的都是这个,甚至还没有完成:

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

I've seen similar code that has loops and whatnot, but none of them seem to be doing what I need to be done. Thank you!

我已经看到类似的代码有循环和诸如此类的东西,但它们似乎都没有做我需要做的事情。谢谢!

EDIT: Current code based off of BruceWayne's. Still doesn't return anything in Excel datasheet's Drawing column, but it looks like it's closer...

编辑:当前代码基于BruceWayne的。仍然没有在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

Another edit! Catalog column is now "C", not "B". Also, I have two header rows, so the first catalog number is located in "C3".

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

Thanks again! We're getting closer.

再次感谢!我们越来越近了。

Here's the Google Drive files: https://drive.google.com/folderview?id=0B2MeeQ3BKptFYnZfQWpwbTJxMm8&usp=sharing

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

IMPORTANT TO REMEMBER

重要的是要记住

In the Google Drive files: TestScript.vbs is the file where all the code is. When the script is run, select ExcelImport. That should return FinalDocument

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

4 个解决方案

#1

I guess this is what you are looking for:

我想这就是你要找的东西:

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

EDIT : For VBScirpt ________________________________________________________________________________

编辑:对于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

#2

How's this work for you?

这对你有用吗?

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

It will set the range to be your Column B, from row 1 to the last row. Then, loop through each cell in there, checking the left two letters. If "ED", then move the data, but take off the "ED".

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

Edit: Just realized you're using VBScript. Remove the as Range and & from the declarations, so it's just Dim lastRow, nextRow, cel, rng.

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

#3

If your criteria is met, this will copy values (minus the ED prefix) from Column B to Column M.

如果符合您的条件,则会将值(从减去ED前缀)复制到B列到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

#4

Why not use some of excel's formulas to speed the whole thing up:

为什么不使用一些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

This should do it for you!

这应该为你做!

#1