VBA腳本複製值，代替正斜槓和合並，同時在Excel

上年底增加一定值我有一個包含值看起來像這樣一個Excel工作表：VBA腳本複製值，代替正斜槓和合並，同時在Excel

BL/ER/D11/fmp000005578/0001 
BL/ER/D11/fmp000005578/0002 
BL/ER/D11/fmp000005578/0002

我需要他們這個樣子：

/data01/BL/ER/D11/fmp000005578/BL_ER_D11_fmp000005578_0001_1.jpg 
/data01/BL/ER/D11/fmp000005578/BL_ER_D11_fmp000005578_0002_1.jpg 
/data01/BL/ER/D11/fmp000005578/BL_ER_D11_fmp000005578_0003_1.jpg

的模式幾乎是：

從末尾刪除號碼。（BL/ER/D11/fmp000005578/）
複製該值，用該下劃線替換該特定值的正斜槓。（BL/ER/D11/fmp000005578/BL_ER_D11_fmp000005578_）
加回數字。（BL/ER/D11/fmp000005578/BL_ER_D11_fmp000005578_0001）
將_1.jpg加到最後。（BL/ER/D11/fmp000005578/BL_ER_D11_fmp000005578_0001_1.jpg）
將/data01/加到前面。（/data01/BL/ER/D11/fmp000005578/BL_ER_D11_fmp000005578_0001_1.jpg）

需要對同一列中的每個值重複該過程。

在一個電子表格中有多個工作表/選項卡，所以不管怎樣，如果可能的話宏應該可以在多個工作表/選項卡上執行。

我目前擁有的代碼是：

Sub FileDirectoryRegExTest() 
    Dim regEx As New RegExp 
    Dim strPattern As String 
    Dim strInput As String 
    Dim strReplace As String 
    Dim Myrange As Range 

    Set Myrange = ActiveSheet.Range("A2:A4620") 

    For Each c In Myrange 
     strPattern = "([A-Z]{2}\/[A-Z]{2}\/[A-Z][0-9]{2}\/[a-z]{3}[0-9]{9}\/)([0-9]{4})" 

     If strPattern <> "" Then 
      strInput = c.Value 
      strReplace = "$1" 

      With regEx 
       .Global = True 
       .MultiLine = True 
       .IgnoreCase = False 
       .Pattern = strPattern 
      End With 

      If regEx.test(strInput) Then 
       c.Offset(0, 1) = regEx.Replace(strInput, "$2") 
      Else 
       c.Offset(0, 1) = "" 
      End If 
     End If 
    Next 
End Sub

我用以前的功能的代碼，但我也不太清楚，如果我可以重新用這個代碼來執行這些特定功能。

如果您可以編輯此腳本或創建一個執行此功能的新腳本，那將非常棒，謝謝！

謝謝！

Aydan H.

來源

2017-07-24 Aydan Howell

您的值'BL/ER/D11/fmp000005578/0001'具有恆定的長度嗎？ – avb

@avb有62000多個值，但從目前爲止我所看到的，是的。他們保持這種一般的格式，正如我在上面的代碼中使用RegEx所強調的那樣。 –

Sub FileDirectoryRegExTest() 
For Each sht In Sheets 
    lastRow = sht.Range("A65000").End(xlUp).Row 
    Set Myrange = sht.Range("A2:A" & lastRow) 
    For Each c In Myrange 
     c.Offset(0, 1) = "/data01/" & Left(c, Len(c) - 4) & Replace(Left(c, Len(c) - 4), "/", "_") & Right(c, 4) & "_1.jpg" 
    Next c 
Next sht 
End Sub

來源

2017-07-24 13:28:04

有沒有辦法爲工作表中的多個選項卡執行此操作？圖片：https：//snag.gy/cIhQ5N.jpg –

代碼爲每個標籤運行。但是，如果每個選項卡上的範圍不同，您可能會遇到問題。您應該使用lastRow = sht.Range（「A65000」）找到最後一個使用的行。結束（xlUp）.Row並設置範圍如下：Set Myrange = sht.Range（「A2：A＆lastRow） –

您能否更新你的代碼上面有那個編輯，我不完全理解。謝謝！有點新的VBA腳本 –

這可以在沒有正則表達式來完成，這是我想了很多，但都是緩慢的，看到這樣的代碼：

Function something(inString As String) As String 
Dim lastSlash As Integer 
Dim firstPart As String, lastPart As String 
    lastSlash = Len(inString) - InStr(1, StrReverse(inString), "/") 
    firstPart = Mid(inString, 1, lastSlash) 
    lastPart = Mid(inString, lastSlash + 2, 9999) 
    something = firstPart & "/" & Replace(firstPart, "/", "_") & "_" & lastPart & "_1.jpg" 
End Function

你甚至可以把它當作一個公式您片。

來源

2017-07-24 13:26:24 avb

如何將它放入模塊中，是否需要在頂部和底部添加Sub x（）和end sub？ –

不，除了subs有函數，只是把它放在一個模塊中，你可以用它作爲工作表上的公式（= somethig（A1）），或者如果你需要在你的VBA代碼中使用它，可以使用它作爲'.Range 「A1」）。Value = somethig（.Range（「B1」）。Value）' – avb

啊我明白了，感謝您的幫助！ –

你真的需要使用正則表達式嗎？

怎麼樣一個簡單的代碼位：

"/data01/" & Mid(c.Value, 1, Len(c.Value) - 4) & Replace(c.Value, "/", "_") & "_1.jpg"

不知道如果數字_1之前的最後一位是爲了遞增？如果他們這樣做，你可以只在字符串中添加一個計數器

來源

2017-07-24 13:29:23 Zac

VBA腳本複製值，代替正斜槓和合並，同時在Excel

回答

相關問題