從另一列填寫色譜柱的值if語句（S）

Question

我現在有一個VBScript接受一個Excel文件並重新格式化爲另一個Excel文檔那是更加有組織英寸 此代碼還必須看目錄欄（「B1」）的值，並將其放置在圖紙列（「M1」），只有當值的開頭「EDASM」開始，「EDBSM」等，但移動時必須消除「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 

我見過有循環和諸如此類的東西類似的代碼，但沒有人似乎在做什麼，我需要完成。謝謝！基於關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 

另一個編輯！ 目錄列現在是「C」，而不是「B」。另外，我有兩個標題行，所以第一個目錄號位於「C3」中。

再次感謝！我們正在接近。

下面是谷歌雲端硬盤文件：https://drive.google.com/folderview?id=0B2MeeQ3BKptFYnZfQWpwbTJxMm8&usp=sharing

重要的是記住

在谷歌雲端硬盤文件：TestScript.vbs是所有的代碼文件。腳本運行時，請選擇ExcelImport。這應該返回FinalDocument

Answer 1

我想這是你在找什麼：

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 

Answer 2

這個怎麼工作的嗎？

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。

Answer 3

如果條件滿足，這將列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 

Answer 4

爲什麼不使用某些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 

這應該爲你做！