Copy part of cells that varies in both length and content using VBA

问题

So I have workbook1 (wbThis) and workbook2 (wbTarget) and in wbThis' sheet I have some cells which are filled. These cells have the format of:

From A6

P2123: Begin procedure

A7

P1234: Code

A8

P4456-6: Document

|

V

(down arrow)

A27

It continues like that. Now I have 2 issues.

Problem1 I want to copy the PXXXxX: (small x is like an arbitrary summation of - or _ or > etc etc) codes to wbTarget. This code varies as you can see but there will always be a "P" in the beginning and a ":" at the end. Regarding this, I have tried with the code:

Dim wbThis As Workbook
Dim wbTarget As Workbook
Dim rowRng As Integer
Dim targetRowRng As Integer

For rowRng 6 To 27
   For targetRowRng 14 To 35 
      If Left((A:rowRng).Value,1) = "P" Then
         wbThis.Sheets("Sheet1").Range(A:rowRng).Copy
         wbTarget.Sheets("Sheet1").Range(E:targetRowRng).PasteSpecial
      End If
   Next
Next

However, as you may have noticed, I have not wrote the code where I want it to end on ":" and copy everything inbetween (including "P" but excluding ":").. I don't know how to code this and I would like your help.

Since the length of PXXXxX varies - something like:

If Left((A:rowRng).Value,1) = "P" Then
   If Left((A:rowRng).Value,5) = ":" Then

won't work, unfortunately.

Problem2 Now there is no way to that all cells of wbThis' range of A6 -> A27 will be filled everytime there's a new document and because I don't want unnecessary copy/pasting I want the script to stop the copy/pasting of PXXXxX: if the script doesn't find a P in eg A16. (if there is no P there is no PXXXxX and then the cell will be empty and therefore redundant - the same applies to all cells under it within the same column) I guess you can code this using else to the If statement above:

ElseIf
       Pass 'Any code here that return to the rest of the script

This doesn't look right though, I haven't found much regarding this.

回答1:

Try this code out. Change object names as needed. this will loop through each cell until A27, checking for the "P...:" combination.

Sub Test()

Dim wbThis As Workbook
Dim wbTarget As Workbook

Set wbThis = Workbooks("Workbook1.xlsx") 'change as needed
Set wbTarget = Workbooks("Workbook2.xlsx") 'change as needed

Dim wsThis As Worksheet
Dim wsTarget As Worksheet

Set wsThis = wbThis.Sheets("Sheet1")
Set wsTarget = wbTarget.Sheets("Sheet1")

Dim rowRng As Integer
Dim targetRowRange As Integer

targetRowRange = 14

For rowRng = 6 To 27

    With wsThis

        If Left(.Cells(rowRng, 1), 1) = "P" Then

            Dim iPos As Integer
            iPos = InStr(1, .Cells(rowRng, 1), ":")

            wsTarget.Cells(targetRowRange, 5).Value = Left(.Cells(rowRng, 1), iPos - 1)

            targetRowRange = targetRowRange + 1

        End If

    End With

Next

End Sub

回答2:

Would

If Right((A:rowRng).Value,1) = ":" Then

be what you want? Alternatively one solution may be to replace the characters with "", e.g.

Replace (Replace ( your_string, "P", ""), ":","")

来源：https://stackoverflow.com/questions/35893074/copy-part-of-cells-that-varies-in-both-length-and-content-using-vba