使用VBA复制长度和内容不同的部分单元格 [英] Copy part of cells that varies in both length and content using VBA

问题描述

所以我有工作簿1（wbThis）和工作簿2（wbTarget），在wbThis'表我有一些填充的单元格。这些单元格的格式为：

从 A6

P2123：开始程序

A7

P1234：代码

A8

P4456-6 ：文件

|

V

（向下箭头）

A27

它继续这样。现在我有2个问题。

Problem1 我想复制 PXXXxX：小x就像一个任意总和的 - 或_或>等等）代码到wbTarget。这段代码会有所不同，你可以看到，但始终始终是P，最后是：。关于这一点，我已经尝试了代码：

  Dim wbThis As Workbook 
 Dim wbTarget As Workbook 
 Dim rowRng As Integer 
 Dim targetRowRng As Integer 
 
对于rowRng 6到27 
对于targetRowRng 14到35 
如果左（（A：rowRng）.Value，1 ）=P然后
 wbThis.Sheets（Sheet1）。范围（A：rowRng）.Copy 
 wbTarget.Sheets（Sheet1）。范围（E：targetRowRng）.PasteSpecial 
结束如果
下一个
下一个
  

但是，你可能已经注意到，我没有写代码，我想要它结束于：，并复制中间的所有内容（包括P但不包括：）..我不知道如何编写代码，我希望你的帮助。

由于PXXXxX的长度有所不同，例如：

$ b $如果左（（A：rowRng）.Value，1）=P然后
如果左（（A：rowRng）.Value，5）= ：然后

不行，不幸的

问题2 现在没有办法让所有单元格的wbThis的范围 A6 - > A27 将每次都有一个新的文档填充，因为我不想不必要的复制/粘贴我想要脚本停止复制/粘贴PXXXxX ：如果脚本没有找到一个P，例如 A16 。 （如果没有P，则没有PXXXxX，然后单元格将为空，因此是冗余的 - 同样适用于同一列内的所有单元）
我猜你可以使用else将其代码到If语句以上：

  ElseIf 
通过'返回脚本其余部分的任何代码
  

这看起来不对，我没有发现太多。

解决方案

尝试这段代码。根据需要更改对象名称。这将循环遍历每个单元格，直到A27，检查P ...：组合。

  Sub Test（）
 
 Dim wbThis As Workbook 
 Dim wbTarget As Workbook 
 
设置wbThis =工作簿（Workbook1.xlsx）根据需要进行更改
设置wbTarget =工作簿（Workbook2.xlsx）'根据需要更改
 
 Dim wsThis As Worksheet 
 Dim wsTarget As Worksheet 
 
设置wsThis = wbThis.Sheets（Sheet1） 
设置wsTarget = wbTarget.Sheets（Sheet1）
 
 Dim rowRng As Integer 
 Dim targetRowRange As Integer 
 
 targetRowRange = 14 
 
对于rowRng = 6到27 
 
与wsThis 
 
如果左（.Cells（rowRng，1），1）=P然后
 
 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 Sub 
  




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.

解决方案

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

这篇关于使用VBA复制长度和内容不同的部分单元格的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！