Fill in Column with values from another column if

2019-09-10 01:50发布

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.

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").

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...

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".

Thanks again! We're getting closer.

Here's the Google Drive files: 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

4条回答
Viruses.
2楼-- · 2019-09-10 02:16

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

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!

查看更多
小情绪 Triste *
3楼-- · 2019-09-10 02:32

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".

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

查看更多
我命由我不由天
4楼-- · 2019-09-10 02:37

If your criteria is met, this will copy values (minus the ED prefix) from Column B to Column 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
查看更多
Explosion°爆炸
5楼-- · 2019-09-10 02:41

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 ________________________________________________________________________________

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
查看更多
登录 后发表回答