Копировать только видимые ячейки из столбца таблицы в один столбец, разделенный запятой в Excel VBA, Loop - PullRequest
Новая
       39

Копировать только видимые ячейки из столбца таблицы в один столбец, разделенный запятой в Excel VBA, Loop

0 голосов
/ 16 июня 2019

Привет всем умным людям,

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

Я хочу скопировать значения ячейки после этого.

Я знаю, что мне, вероятно, следует использовать SpecialCells (xlCellTypeVisible), но я не могу понять, где в моем коде.

Этот код начинается с номера строки 11 

Sub Onecell()
Dim i As Integer
Dim count As Integer
Dim s As String
count = Cells(Rows.count, "A").End(xlUp).Row
For i = 11 To count
s = s & Cells(i, 1) & ","
Next
Range("D11") = s

Range("D11").Select
Selection.Copy

End Sub

Ожидаемые результаты следующие:

Допустим, у меня есть такая таблица.

USA     2019
SWEDEN      2019
NORWAY      2019
INDIA       2020
GERMANY     2020
SPAIN       2020

Если я отфильтрую таблицу, например, по 2019 году,

, тогда я хочу только в ячейку D11 США, ШВЕЦИЯ, НОРВЕГИЯ

Если я отфильтрую по 2020 году, то яхочу в ячейку D11 ИНДИЯ, ГЕРМАНИЯ, ИСПАНИЯ

Я совершенно уверен, что проблема в том, что я должен поместить

SpecialCells (xlCellTypeVisible) куда-нибудь

Любая помощь очень высокаappriciated

1 Ответ

0 голосов
/ 16 июня 2019

Это должно работать для вас: 

Option Explicit
Sub Onecell()

    Dim count As Integer
    Dim JoinCells As New Scripting.Dictionary 'You need to go to tools-->references--> Check: Microsoft Scripting Runtime
    Dim C As Range

    With ThisWorkbook.Sheets("MySheet") 'Change MySheet for your sheet name
        count = .Cells(.Rows.count, "A").End(xlUp).Row
        For Each C In .Range("A11", .Cells(count, 1)).SpecialCells(xlCellTypeVisible) 'like this you will only loop through visible ones
            If Not JoinCells.Exists(C.Value) Then JoinCells.Add C.Value, 1 'store all the visible items
        Next C
        .Range("D11") = Join(JoinCells.Keys, ", ")
    End With

End Sub
...