изменить на Dynami c VBA - PullRequest
       2

изменить на Dynami c VBA

0 голосов
/ 27 апреля 2020

Я хочу, чтобы строки из одной копии таблицы на другой лист основывались на заданном тексте c, мне нужно, чтобы он запускался, так как новые данные будут добавляться ежедневно, сейчас я использую этот код, но его нужно запускать после ввод данных.

 Sub CopyYes()
    Dim c As Range
    Dim j As Integer
    Dim Source As Worksheet
    Dim Target As Worksheet
    Set Source = ActiveWorkbook.Worksheets("MAINGANG")
    Set Target = ActiveWorkbook.Worksheets("REPAIRS")

    j = 4     
    For Each c In Source.Range("C4:C10000")   
        If c = "X" Then
           Source.Rows(c.Row).Copy Target.Rows(j)
           j = j + 1
    End If
Next c    
End Sub

Ответы [ 3 ]

0 голосов
/ 27 апреля 2020

Обычно я использую массив для обработки следующим образом '--------------------------------

dim arr(),temp()
worksheets(1).activate
arr=[a1].currentregion

j=0
for i=1 to ubound(arr)
 if arr(i)="x" then
  j=j+1
  redim preserve temp(j)
  temp(j)=arr(i)
 end if
next

worksheets(2).activate
range("a1:a"&ubound(temp))=temp
0 голосов
/ 27 апреля 2020

Попробуй,

 Sub CopyYes()
    Dim Source As Worksheet
    Dim Target As Worksheet
    Dim vDB, vR()
    Dim i As Long, n As Long, r As Long
    Dim j As Integer, c As Integer

    Set Source = ActiveWorkbook.Worksheets("MAINGANG")
    Set Target = ActiveWorkbook.Worksheets("REPAIRS")

    vDB = Source.UsedRange

    r = UBound(vDB, 1)
    c = UBound(vDB, 2)
    For i = 4 To r
        If vDB(i, 3) = "X" Then
            n = n + 1
            ReDim Preserve vR(1 To c, 1 To n)
            For j = 1 To c
                vR(j, n) = vDB(i, j)
            Next j
        End If
    End If
    Target.Range("a4").Resize(n, c) = WorksheetFunction.Transpose(vR)
End Sub
0 голосов
/ 27 апреля 2020

Я думаю, что это достигнет того, что вы ищете:

 Sub CopyYes()
    Dim myCell As Range
    Dim LastColumnSource As Long 'Integer data type is outdated.
    Dim LastRowTarget As Long
    Dim SourceSheet As Worksheet
    Dim TargetSheet As Worksheet
    Dim SourceRange As Range
    Dim TargetRange As Range
    Dim myArray As Variant

    Set SourceSheet = ActiveWorkbook.Worksheets("Sheet1") <~~ change to your sheet name
    Set TargetSheet = ActiveWorkbook.Worksheets("Sheet2") <~~ change to your sheet name

    'Change the 1 to whichever column you need (1 represents column A)
    LastRowTarget = TargetSheet.Cells(Rows.Count, 1).End(xlUp).Row
    LastRowSource = SourceSheet.Cells(Rows.Count, 3).End(xlUp).Row

    Set SourceRange = SourceSheet.Range("C4:C" & LastRowSource)

    j = 4
    For Each myCell In SourceRange
        If myCell.Value = "X" Then
           LastColumnSource = SourceSheet.Cells(myCell.Row, Columns.Count).End(xlToLeft).Column
           myArray = SourceSheet.Range(Cells(myCell.Row, 1), Cells(myCell.Row, LastColumnSource))

           LastColumnTarget = TargetSheet.Cells(LastRowTarget, Columns.Count).End(xlToLeft).Column
           Set TargetRange = TargetSheet.Range("A" & LastRowTarget)
           TargetRange.Resize(1, UBound(myArray, 2)) = myArray


           LastRowTarget = LastRowTarget + 1

        End If
    Next myCell
End Sub

Чтобы сделать его динамическим c, последняя строка и последний столбец найдены для обоих листов, и строка записана в массив затем написать обратно на лист результатов (что позволяет избежать использования копии).

Поскольку я недостаточно знаю о вашем проекте, я оставил ActiveWorkbook, но вам лучше указать рабочую книгу (или ThisWorkbook, если это рабочая книга, из которой запускается код) - Это позволяет избежать ошибок времени выполнения, если код выполняется, пока другая книга находится в фокусе.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...