Добрый день! Подскажите пожалуйста, возможно ли данной функцией выделить несмежные диапазоны, если да. Мне кажется, что она выделяет несмежные диапазоны, но вот не пойму, почему мой макрос, сделанный для удаления выделенных столбцов в таблице, в случае выделения нескольких не смежных диапазонов, удаляет только столбцы, относящиеся к первому диапазону. [vba]
Код
Sub Удаление_ненужных_столбцов()
Dim range1 As Range Dim iCell As Range Dim i, j, k As Long Dim perechen As String Dim NameStolbec() As String shapka = InputBox("Укажите номер строки, в которой представлена шапка вашей таблицы", "Позиция шапки", "1") Set range1 = Application.InputBox("Выделите ячейку (наименование в шапке) удаляемого (удаляемых) столбцов", Type:=8) perechen = InputBox("Нужен ли перечень удалённых столбцов?", "Составление перечня", "Да") Application.ScreenUpdating = False j_n = Cells(shapka, Columns.Count).End(xlToLeft).Column i_n = range1.Cells.Count MsgBox (i_n) For i = 1 To i_n ReDim Preserve NameStolbec(i_n) NameStolbec(i) = range1(i) Next i For i = 1 To i_n For j = 1 To j_n Step 1 If Cells(shapka, j).Value = NameStolbec(i) Then Columns(j).Select Columns(j).Delete k = k + 1 If perechen = "Да" Then If perech = "" Then perech = NameStolbec(i) & Chr(13) Else perech = perech & NameStolbec(i) & Chr(13) End If End If End If Next j Next i Application.ScreenUpdating = True MsgBox ("Удалено " & k & " столбцов") If perechen = "Да" Then If perech <> "" Then MsgBox ("Перечень удалённых столбцов: " & Chr(13) & perech) End If End If End Sub
[/vba]
Кроме того, количество ячеек в выделенном диапазоне считает правильно " i_n = range1.Cells.Count", а вот когда пытаюсь посмотреть элементы диапазона "range1(i)", то их показывает только для первого из нескольких несмежных диапазонов ячеек. Для столбцов из несмежных диапазонов "range1(i)" = ""
Добрый день! Подскажите пожалуйста, возможно ли данной функцией выделить несмежные диапазоны, если да. Мне кажется, что она выделяет несмежные диапазоны, но вот не пойму, почему мой макрос, сделанный для удаления выделенных столбцов в таблице, в случае выделения нескольких не смежных диапазонов, удаляет только столбцы, относящиеся к первому диапазону. [vba]
Код
Sub Удаление_ненужных_столбцов()
Dim range1 As Range Dim iCell As Range Dim i, j, k As Long Dim perechen As String Dim NameStolbec() As String shapka = InputBox("Укажите номер строки, в которой представлена шапка вашей таблицы", "Позиция шапки", "1") Set range1 = Application.InputBox("Выделите ячейку (наименование в шапке) удаляемого (удаляемых) столбцов", Type:=8) perechen = InputBox("Нужен ли перечень удалённых столбцов?", "Составление перечня", "Да") Application.ScreenUpdating = False j_n = Cells(shapka, Columns.Count).End(xlToLeft).Column i_n = range1.Cells.Count MsgBox (i_n) For i = 1 To i_n ReDim Preserve NameStolbec(i_n) NameStolbec(i) = range1(i) Next i For i = 1 To i_n For j = 1 To j_n Step 1 If Cells(shapka, j).Value = NameStolbec(i) Then Columns(j).Select Columns(j).Delete k = k + 1 If perechen = "Да" Then If perech = "" Then perech = NameStolbec(i) & Chr(13) Else perech = perech & NameStolbec(i) & Chr(13) End If End If End If Next j Next i Application.ScreenUpdating = True MsgBox ("Удалено " & k & " столбцов") If perechen = "Да" Then If perech <> "" Then MsgBox ("Перечень удалённых столбцов: " & Chr(13) & perech) End If End If End Sub
[/vba]
Кроме того, количество ячеек в выделенном диапазоне считает правильно " i_n = range1.Cells.Count", а вот когда пытаюсь посмотреть элементы диапазона "range1(i)", то их показывает только для первого из нескольких несмежных диапазонов ячеек. Для столбцов из несмежных диапазонов "range1(i)" = ""Roman777
Много чего не знаю!!!!
Сообщение отредактировал Roman777 - Понедельник, 23.03.2015, 14:40
Dim range1 As Range Dim iCell As Range Dim shapka As Long Dim i As Long, j As Long, k As Long, i_n As Long, j_n As Long Dim perechen As Boolean Dim perech As String Dim NameStolbec() As String
shapka = Application.InputBox("Укажите номер строки, в которой представлена шапка вашей таблицы") Set range1 = Application.InputBox("Выделите ячейку (наименование в шапке) удаляемого (удаляемых) столбцов", Type:=8) perechen = MsgBox("Нужен ли перечень удалённых столбцов?", vbQuestion Or vbYesNo) Application.ScreenUpdating = False j_n = Cells(shapka, Columns.Count).End(xlToLeft).Column i_n = range1.Cells.Count MsgBox (i_n) ReDim Preserve NameStolbec(i_n) For i = 1 To i_n NameStolbec(i) = range1(, i) Next i For i = 1 To i_n For j = 1 To j_n Step 1 If Cells(shapka, j).Value = NameStolbec(i) Then 'Columns(j).Select Columns(j).Delete j_n = j_n - 1 k = k + 1 If perechen Then perech = perech & Chr(13) & NameStolbec(i) End If Exit For End If Next j Next i Application.ScreenUpdating = True MsgBox ("Удалено " & k & " столбцов") If perechen Then If perech <> "" Then MsgBox ("Перечень удалённых столбцов: " & perech) End If End If End Sub
тебе нужно перебирать не ячейки диапазона ("range1(i)"), а столбцы диапазона ("range1(, i)"), т.к. в шапке могут быть объединенные ячейки.
попробуй [vba]
Код
Sub Удаление_ненужных_столбцов()
Dim range1 As Range Dim iCell As Range Dim shapka As Long Dim i As Long, j As Long, k As Long, i_n As Long, j_n As Long Dim perechen As Boolean Dim perech As String Dim NameStolbec() As String
shapka = Application.InputBox("Укажите номер строки, в которой представлена шапка вашей таблицы") Set range1 = Application.InputBox("Выделите ячейку (наименование в шапке) удаляемого (удаляемых) столбцов", Type:=8) perechen = MsgBox("Нужен ли перечень удалённых столбцов?", vbQuestion Or vbYesNo) Application.ScreenUpdating = False j_n = Cells(shapka, Columns.Count).End(xlToLeft).Column i_n = range1.Cells.Count MsgBox (i_n) ReDim Preserve NameStolbec(i_n) For i = 1 To i_n NameStolbec(i) = range1(, i) Next i For i = 1 To i_n For j = 1 To j_n Step 1 If Cells(shapka, j).Value = NameStolbec(i) Then 'Columns(j).Select Columns(j).Delete j_n = j_n - 1 k = k + 1 If perechen Then perech = perech & Chr(13) & NameStolbec(i) End If Exit For End If Next j Next i Application.ScreenUpdating = True MsgBox ("Удалено " & k & " столбцов") If perechen Then If perech <> "" Then MsgBox ("Перечень удалённых столбцов: " & perech) End If End If End Sub
KSV, Программка работает аналогично. Если выделить несколько несмежных диапазонов, удалены будут только те столбцы, которые относятся к первому диапазону. Как пример скинул файлик. В нём "мнимая" табличка. Пометим на удаление всё что выделено жёлтым. Удаляется только 1-5 столбиков, остальные 11-19 и 23-26 останутся.
KSV, Программка работает аналогично. Если выделить несколько несмежных диапазонов, удалены будут только те столбцы, которые относятся к первому диапазону. Как пример скинул файлик. В нём "мнимая" табличка. Пометим на удаление всё что выделено жёлтым. Удаляется только 1-5 столбиков, остальные 11-19 и 23-26 останутся.Roman777
Кстати, KSV, я никогда msgbox не пользовался для выполнения условий, подскажите пожалуйста, почему и в случае ответа Да и в случае Нет, переменная perechen по Вашему коду принимает значение "True", то есть и расчёт и табличка с перечнем выскочат в любом случае, независимо от ответа? Подскажите пожалуйста, как это можно подправить?
Кстати, KSV, я никогда msgbox не пользовался для выполнения условий, подскажите пожалуйста, почему и в случае ответа Да и в случае Нет, переменная perechen по Вашему коду принимает значение "True", то есть и расчёт и табличка с перечнем выскочат в любом случае, независимо от ответа? Подскажите пожалуйста, как это можно подправить?Roman777
Dim range1 As Range Dim iCell As Range Dim i As Long, j As Long, k As Long, i_n As Long, j_n As Long, shapka As Long Dim perechen As Boolean Dim perech As String Dim NameStolbec() As String
shapka = Application.InputBox("Укажите номер строки, в которой представлена шапка вашей таблицы") Set range1 = Application.InputBox("Выделите ячейку (наименование в шапке) удаляемого (удаляемых) столбцов", Type:=8) perechen = MsgBox("Нужен ли перечень удалённых столбцов?", vbQuestion Or vbYesNo) = vbYes Application.ScreenUpdating = False j_n = Cells(shapka, Columns.Count).End(xlToLeft).Column i_n = range1.Cells.Count MsgBox (i_n) ReDim Preserve NameStolbec(i_n) For i = 1 To i_n NameStolbec(i) = range1(, i) Next i For i = 1 To i_n For j = j_n To 1 Step -1 If Cells(shapka, j).Value = NameStolbec(i) Then 'Columns(j).Select Columns(j).Delete k = k + 1 If perechen Then perech = perech & Chr(13) & NameStolbec(i) End If End If Next j Next i Application.ScreenUpdating = True MsgBox ("Удалено " & k & " столбцов") If perechen Then If perech <> "" Then MsgBox ("Перечень удалённых столбцов: " & perech) End If End If End Sub
[/vba]
пробуй
[vba]
Код
Option Explicit
Sub Удаление_ненужных_столбцов()
Dim range1 As Range Dim iCell As Range Dim i As Long, j As Long, k As Long, i_n As Long, j_n As Long, shapka As Long Dim perechen As Boolean Dim perech As String Dim NameStolbec() As String
shapka = Application.InputBox("Укажите номер строки, в которой представлена шапка вашей таблицы") Set range1 = Application.InputBox("Выделите ячейку (наименование в шапке) удаляемого (удаляемых) столбцов", Type:=8) perechen = MsgBox("Нужен ли перечень удалённых столбцов?", vbQuestion Or vbYesNo) = vbYes Application.ScreenUpdating = False j_n = Cells(shapka, Columns.Count).End(xlToLeft).Column i_n = range1.Cells.Count MsgBox (i_n) ReDim Preserve NameStolbec(i_n) For i = 1 To i_n NameStolbec(i) = range1(, i) Next i For i = 1 To i_n For j = j_n To 1 Step -1 If Cells(shapka, j).Value = NameStolbec(i) Then 'Columns(j).Select Columns(j).Delete k = k + 1 If perechen Then perech = perech & Chr(13) & NameStolbec(i) End If End If Next j Next i Application.ScreenUpdating = True MsgBox ("Удалено " & k & " столбцов") If perechen Then If perech <> "" Then MsgBox ("Перечень удалённых столбцов: " & perech) End If End If End Sub
KSV, Так, я пока только попробовал пару раз, но по тому примеру, что я прикреплял, работает неверно. Удаляет даже те столбцы, которые не выделял и кроме этого, не удаляет все, что выделил я. (По файлу удалил 1-18, оставил 19-26). Счас попробую понять что не так.))) Сразу хочу спросить, а что такое "Option Explicit"?
KSV, Так, я пока только попробовал пару раз, но по тому примеру, что я прикреплял, работает неверно. Удаляет даже те столбцы, которые не выделял и кроме этого, не удаляет все, что выделил я. (По файлу удалил 1-18, оставил 19-26). Счас попробую понять что не так.))) Сразу хочу спросить, а что такое "Option Explicit"?Roman777
With Application.InputBox("Выделите ячейку (наименование в шапке) удаляемого (удаляемых) столбцов", Type:=8) Set range1 = .EntireColumn MsgBox (range1.Columns.Count) End With
[/vba] Если чё эт просто эксперимент... Почему-то данный код выдаёт количество только для первого диапазона, если выделено несколько смежных. (выделил 1-5, 16-20 столбцы). А данное выражение даёт значение 5.
[vba]
Код
With Application.InputBox("Выделите ячейку (наименование в шапке) удаляемого (удаляемых) столбцов", Type:=8) Set range1 = .EntireColumn MsgBox (range1.Columns.Count) End With
[/vba] Если чё эт просто эксперимент... Почему-то данный код выдаёт количество только для первого диапазона, если выделено несколько смежных. (выделил 1-5, 16-20 столбцы). А данное выражение даёт значение 5.Roman777
Много чего не знаю!!!!
Сообщение отредактировал Roman777 - Понедельник, 23.03.2015, 16:05
wild_pig, спасибо за подсказку, это значительно упрощает весь этот "огород" [vba]
Код
Option Explicit Option Base 1
Sub Удаление_ненужных_столбцов() Dim range1 As Range Dim i As Long, j As Long, k As Long, shapka As Long Dim perechen As Boolean Dim perech As String Dim NameStolbec() As String
'shapka = Application.InputBox("Укажите номер строки, в которой представлена шапка вашей таблицы") Set range1 = Application.InputBox("Выделите ячейку (наименование в шапке) удаляемого (удаляемых) столбцов", Type:=8) perechen = MsgBox("Нужен ли перечень удалённых столбцов?", vbQuestion Or vbYesNo) = vbYes
k = range1.Cells.Count MsgBox (k)
ReDim NameStolbec(k) For j = 1 To range1.Areas.Count For i = 1 To range1.Areas(j).Columns.Count NameStolbec(i) = range1.Areas(j).Columns(i).Value If perechen Then _ perech = perech & vbCr & NameStolbec(i) Next Next
MsgBox ("Удалено " & k & " столбцов") If perech <> "" Then MsgBox ("Перечень удалённых столбцов: " & perech) End If End Sub
[/vba]
wild_pig, спасибо за подсказку, это значительно упрощает весь этот "огород" [vba]
Код
Option Explicit Option Base 1
Sub Удаление_ненужных_столбцов() Dim range1 As Range Dim i As Long, j As Long, k As Long, shapka As Long Dim perechen As Boolean Dim perech As String Dim NameStolbec() As String
'shapka = Application.InputBox("Укажите номер строки, в которой представлена шапка вашей таблицы") Set range1 = Application.InputBox("Выделите ячейку (наименование в шапке) удаляемого (удаляемых) столбцов", Type:=8) perechen = MsgBox("Нужен ли перечень удалённых столбцов?", vbQuestion Or vbYesNo) = vbYes
k = range1.Cells.Count MsgBox (k)
ReDim NameStolbec(k) For j = 1 To range1.Areas.Count For i = 1 To range1.Areas(j).Columns.Count NameStolbec(i) = range1.Areas(j).Columns(i).Value If perechen Then _ perech = perech & vbCr & NameStolbec(i) Next Next
KSV, а я ваш код подредактировал и вроде всё отлично пашет).
[vba]
Код
'Option Explicit
Sub Удаление_ненужных_столбцов2()
Dim range1 As Range Dim iCell As Range Dim i As Long, j As Long, k As Long, i_n As Long, j_n As Long, shapka As Long Dim perechen As Boolean Dim perech As String Dim NameStolbec() As String
shapka = Application.InputBox("Укажите номер строки, в которой представлена шапка вашей таблицы") Set range1 = Application.InputBox("Выделите ячейку (наименование в шапке) удаляемого (удаляемых) столбцов", Type:=8) perechen = MsgBox("Нужен ли перечень удалённых столбцов?", vbQuestion Or vbYesNo) = vbYes Application.ScreenUpdating = False j_n = Cells(shapka, Columns.Count).End(xlToLeft).Column i_n = range1.Cells.Count i = 0 perech = "" ReDim Preserve NameStolbec(i_n) For Each iCell In range1 ' MsgBox (iCell.Cells.Count) i = i + 1 NameStolbec(i) = iCell MsgBox (i & " / " & NameStolbec(i)) Next iCell i = i_n For i = 1 To i_n For j = j_n To 1 Step -1 If Cells(shapka, j).Value = NameStolbec(i) Then 'Columns(j).Select Columns(j).Delete k = k + 1 If perechen Then If perech = "" Then perech = NameStolbec(i) & Chr(13) Else perech = perech & NameStolbec(i) & Chr(13) End If End If End If Next j Next i Application.ScreenUpdating = True MsgBox ("Удалено " & k & " столбцов") If perechen Then If perech <> "" Then MsgBox ("Перечень удалённых столбцов: " & Chr(13) & perech) End If End If End Sub
[/vba]
Спасибо большое за помощь). Блин, такая простая задача, а времени отняла оч много.
KSV, а я ваш код подредактировал и вроде всё отлично пашет).
[vba]
Код
'Option Explicit
Sub Удаление_ненужных_столбцов2()
Dim range1 As Range Dim iCell As Range Dim i As Long, j As Long, k As Long, i_n As Long, j_n As Long, shapka As Long Dim perechen As Boolean Dim perech As String Dim NameStolbec() As String
shapka = Application.InputBox("Укажите номер строки, в которой представлена шапка вашей таблицы") Set range1 = Application.InputBox("Выделите ячейку (наименование в шапке) удаляемого (удаляемых) столбцов", Type:=8) perechen = MsgBox("Нужен ли перечень удалённых столбцов?", vbQuestion Or vbYesNo) = vbYes Application.ScreenUpdating = False j_n = Cells(shapka, Columns.Count).End(xlToLeft).Column i_n = range1.Cells.Count i = 0 perech = "" ReDim Preserve NameStolbec(i_n) For Each iCell In range1 ' MsgBox (iCell.Cells.Count) i = i + 1 NameStolbec(i) = iCell MsgBox (i & " / " & NameStolbec(i)) Next iCell i = i_n For i = 1 To i_n For j = j_n To 1 Step -1 If Cells(shapka, j).Value = NameStolbec(i) Then 'Columns(j).Select Columns(j).Delete k = k + 1 If perechen Then If perech = "" Then perech = NameStolbec(i) & Chr(13) Else perech = perech & NameStolbec(i) & Chr(13) End If End If End If Next j Next i Application.ScreenUpdating = True MsgBox ("Удалено " & k & " столбцов") If perechen Then If perech <> "" Then MsgBox ("Перечень удалённых столбцов: " & Chr(13) & perech) End If End If End Sub
[/vba]
Спасибо большое за помощь). Блин, такая простая задача, а времени отняла оч много.Roman777
With Application.InputBox("Выделите ячейку (наименование в шапке) удаляемого (удаляемых) столбцов", Type:=8) Set range1 = .EntireColumn For Each ar In .Areas sm = sm + ar.Columns.Count Next MsgBox sm End With
[/vba]
[vba]
Код
With Application.InputBox("Выделите ячейку (наименование в шапке) удаляемого (удаляемых) столбцов", Type:=8) Set range1 = .EntireColumn For Each ar In .Areas sm = sm + ar.Columns.Count Next MsgBox sm End With
With Application.InputBox("Выделите ячейку (наименование в шапке) удаляемого (удаляемых) столбцов", Type:=8) MsgBox .Count .EntireColumn.Delete End With
[/vba] Только не удалить колонки перед сообщением
[vba]
Код
With Application.InputBox("Выделите ячейку (наименование в шапке) удаляемого (удаляемых) столбцов", Type:=8) MsgBox .Count .EntireColumn.Delete End With
[/vba] Только не удалить колонки перед сообщениемwild_pig
Roman777, тебе же, как я понял, нужно информировать пользователя не только о кол-ве удаляемых столбцов, и выводить наименования (из шапки таблицы) удаленных столцов? (если пользователь утвердительно ответит на вопрос: "Нужен ли перечень удалённых столбцов?")
Roman777, тебе же, как я понял, нужно информировать пользователя не только о кол-ве удаляемых столбцов, и выводить наименования (из шапки таблицы) удаленных столцов? (если пользователь утвердительно ответит на вопрос: "Нужен ли перечень удалённых столбцов?")
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
