Скопируйте данные на основе l oop, а затем вставьте данные на несколько листов, созданных на основе массива - PullRequest
Новая
       3

Скопируйте данные на основе l oop, а затем вставьте данные на несколько листов, созданных на основе массива

0 голосов
/ 30 мая 2020

Я создаю новые данные, которые зависят от переменной x, используя l oop, затем пытаюсь скопировать данные с каждой итерацией в X, а затем вставляю данные на несколько листов (переменная «FundSheetNames»). Здесь я не знаю, как выйти из l oop FundSheetNames без следующего i, а затем снова go на X, чтобы скопировать новые данные. 

Sub peer2()

ThisWorkbook.Sheets("Peer Code").Activate
Dim X As Range, Y As Range
Set X = Sheets("Peer Code").Range("J2:J11")

Dim Sht As Worksheet
Dim sheet_names As Variant

For Each sheet_Name In Sheets("Peer Code").Range("K2:K3")
For Each Y In X

Set WS = Worksheets(sheet_Name.Text)

    ThisWorkbook.Sheets("Peer Fund").Activate
    Range("F7:F166").Select
    Selection.ClearContents

    ThisWorkbook.Sheets("Peer Code").Activate
    Y.Select
    Selection.Copy
    Range("L2").Select
    Selection.PasteSpecial Paste:=xlPasteValues

    Range("N2:N161").Select
    Selection.Copy


    ThisWorkbook.Sheets("Peer Fund").Activate
    Range("F7").EntireColumn.Hidden = False
    Range("$F7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, 
     SkipBlanks:= _
    False, Transpose:=False

    With Sheets("Peer Fund")
        Set FOUNDRANGE = .Columns("F:F").Find("*", After:=.Range("F167"), searchdirection:=xlPrevious, LookIn:=xlValues)
        If Not FOUNDRANGE Is Nothing Then LR1 = FOUNDRANGE.Row
    End With
    Range("F166:F" & LR1 + 1).EntireRow.Select
    Application.Selection.EntireRow.Hidden = False

        Range("A6:W" & LR1).Select
    ActiveWorkbook.Worksheets("Peer Fund").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Peer Fund").Sort.SortFields.Add2 Key _
    :=Range("A2:A" & LR1), SortOn:=xlSortOnValues, Order:=xlAscending, _
    DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Peer Fund").Sort
        .SetRange Range("A6:W" & LR1)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With


    Range("F7").EntireColumn.Hidden = False
    Range("A5:W172").Select
    Selection.SpecialCells(xlCellTypeVisible).Copy

    WS.Activate
    Range("A5").Select
    Selection.PasteSpecial Paste:=xlPasteValues
    Selection.PasteSpecial Paste:=xlPasteFormats
          With WS
              Set FOUNDRANGE = .Columns("F:F").Find("*", 
              After:=.Range("F167"), 
              searchdirection:=xlPrevious, LookIn:=xlValues)
              If Not FOUNDRANGE Is Nothing Then LR2 = FOUNDRANGE.Row
        End With
    Range("F166:F" & LR1 + 1).EntireRow.Select
    Application.Selection.EntireRow.Hidden = True
    Range("F7").EntireColumn.Hidden = True

Next Y
Next sheet_Name

End Sub

1 Ответ

0 голосов
/ 30 мая 2020

Выход для

Откройте новый рабочий лист и поместите код в модуль. Затем введите значения в столбец A. Поместите несколько 5 -s среди значений .

Ниже приведен пример поиска значения 5 в столбце A. Когда 5 найден, он возвращает сообщение, содержащее адрес ячейки, в которой он был найден, в Immediate window ( CTRL + G ). 

Option Explicit

Sub FirstOccurrence()

    Const Col As Variant = "A"
    Const FirstRow As Long = 2
    Const Criteria As Long = 5

    Dim rng As Range
    ' Define the last non-empty cell.
    Set rng = Columns(Col).Find("*", , xlValues, , , xlPrevious)
    If rng Is Nothing Then Exit Sub
    If rng.Row < FirstRow Then Exit Sub
    ' Define the column range from FirstRow to row of last non-empty cell.
    Set rng = Range(Cells(FirstRow, Col), rng)

    Dim cel As Range
    For Each cel In rng
        If cel.Value = Criteria Then
            Debug.Print "Cell '" & cel.Address & "' contains the value '" _
              & Criteria & "'."
            Exit For
        End If
    Next cel

End Sub

Вы только что видели, как код находит только первое вхождение 5.

Теперь удалите строку Exit For и посмотрите результаты в Immediate window ( CTRL + G ).

...