Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Удаление строк по условию из массива
 
#1
13.03.2019 13:50:27
Добрый день, уважаемые знатоки.
У меня возникла задача собрать массив из столбцов, поменять столбцы местами, затем из массива удалить строки со словом "уд", удалить столбец, в котором встречается слово "уд" и выгрузить результат на Лист2.
С первой частью прекрасно справляется макрос Anchoret
Код
Sub aaa()
Dim aa(), a&, lr1&
lr1 = Cells(Rows.Count, 1).End(xlUp).Row

With Sheets(1)
  aa = Array("A", "B", "B", "F", "C", "H", "D", "C")
  For a = 0 To UBound(aa) Step 2
   Worksheets("Лист2").Range(aa(a + 1) & "3:" & aa(a + 1) & lr1 + 1).Value = Range(aa(a) & "2:" & aa(a) & lr1).Value
  Next
End With
'
End Sub
А вот с удалением у меня беда. Помогите, пожалуйста.
 
 
 
#2
13.03.2019 20:25:31
Цитата
casag написал:
собрать массив из столбцов
Каков на самом деле размер ваших данных в листе, или только столбцы от "A" до "D", или какой-то другой, больший ?

Цитата
casag написал:
удалить столбец, в котором встречается слово "уд"
Но ведь в вашем примере это всегда будет столбец "C" ?

Цитата
casag написал:
и выгрузить результат на Лист2
Если ваш пример достоверный, вы можете сделать это следующим образом:
Код
Option Explicit

Sub ccc()
    Const isk$ = "уд"
    Dim c%, r&, ws As Worksheet
    With ThisWorkbook
        Set ws = .Sheets("Лист1")
        r = 2: c = ws.Range("A2").CurrentRegion.Columns.Count
        With .Sheets("Лист2")
            Do Until ws.Cells(r, "A").Value = ""
                If Not Join(Application.Index(ws.Cells(r, "A").Resize(1, c).Value, 0), " ") Like "*" & isk & "*" Then
                    .Range("B" & .Rows.Count).End(xlUp).Offset(1, 0).Value = ws.Range("A" & r).Value
                    .Range("B" & .Rows.Count).End(xlUp).Offset(0, 1).Value = ws.Range("A" & r).Offset(0, 3).Value
                    .Range("B" & .Rows.Count).End(xlUp).Offset(0, 4).Value = ws.Range("A" & r).Offset(0, 1).Value
                End If
                r = r + 1
            Loop
        End With
    End With
    Set ws = Nothing
End Sub
 
 
 
#3
13.03.2019 20:57:24
Добрый вечер,ocet p,.Спасибо большое за макрос, на будущее пригодится.   Но я в описании из-за лаконичности, наверное, упустил важное. Реальный файл очень большой, около 600 столбцов из которых нужно больше сотни перенести, и около 2000 строк, удалить нужно половину. Через макрос Anchoret  получается достаточно быстро, нужно только помучится ввести пары столбцов.Я думал что можно в этом же массиве отфильтровать ненужные строки вниз и удалить их вместе со столбцом ( в примере это "С"). Но, если это сложно, то есть вариант "Б" - выгрузить этот массив, а потом собрать в массив ненужные строки и оптом их удалить.
Еще раз спасибо за макрос и потраченное время.
 
 
 
#4
14.03.2019 18:30:00
Когда дело доходит до избавления от "уд", то используйте самый простой 'SQL', например:
Код
strSql = "SELECT * FROM [List1$] WHERE [Zagol3] <> '" & isk & "';"
где 'isk'
Код
Const isk$ = "уд"

"List1" - это название листа,

только вам нужно сначала вставить временные заголовки для данных из "List1" (Zagol1, Zagol2, Zagol3, и так далее), например:

Код
For i = 1 To indc
    ThisWorkbook.Sheets("List1").Cells(1, i).Value = "Zagol" & CStr(i)
Next
а затем 'SQL' в 'QueryTables', например:
Код
With ThisWorkbook.Sheets("List2")
    .Select
    With .QueryTables.Add(Connection:=strCon, Destination:=.Range("A2"), Sql:=strSql)
        .FieldNames = True                    'или False
        .AdjustColumnWidth = False            'или True
        .RefreshStyle = xlInsertEntireRows
        .Refresh BackgroundQuery:=False
        .Delete
    End With
End With
где 'strCon' например:
Код
strCon = "ODBC;DSN=Excel Files;DBQ=" & dbPath & ";"
где 'dbPath' например:
Код
dbPath = ThisWorkbook.FullName
, затем удалите ненужный столбец
Код
ThisWorkbook.Sheets("List2").Columns(nrc).Delete
'или
ThisWorkbook.Sheets("List2").Columns(adrs & ":" & adrs).Delete
где 'nrc' и 'adrs' (поиск столбца с "уд" = 'isk') например:
Код
With ThisWorkbook.Sheets("List1")
    For i = 1 To indc
        If Not IsError(Application.Match(isk, .Columns(i), 0)) Then
            nrc = i                                                         'Номер столбца с "уд"
            adrs = Split(.Columns(i).Cells(1).Address(1, 0), "$", -1, 1)(0) 'Адрес столбца с "уд"
            Exit For
        End If
    Next
End With
где 'indc' например:
Код
indc = ThisWorkbook.Sheets("List1").Range("A2").CurrentRegion.Columns.Count
 
 
 
#5
14.03.2019 21:57:14
ocet p, спасибо за помощь и отзывчивость.Вы не первый раз мне помогаете. Полгода назад, благодаря вашему макросу написанному для меня, я понял какой это мощный инструмент и начал, в меру моих сил, изучать макросы. Теперь, похоже, вы решили меня подсадить на 'SQL' (: Спасибо, буду разбираться и изучать.
 
 
 
Страницы: 1
Наверх