Перемещение колонок в таблице по условию

[Brine]

Задача: В таблице Microsoft Office Excel 2003 с помощью VB Script макроса разместить колонки в заданном порядке, по шаблону (Лист 1).

Условие: В исходном (обрабатываемом) документе колонки (столбцы) всегда расположенны в разных местах (Лист 2) , (Лист 3).

Желаемый способ решения задачи: Берем ячейку (A1), если значение равно "п/н" переходим к (B1), если значение не равно "п/н", на место колонки (А) вставляем пустую колонку. По порядку перебираем ячейки (B1), (C1), (D1), (F1) и т.д. пока не найдем колонку первая ячейка которой содержит "п/н". Вырезаем эту колонку и вставляем в пустую колонку (А).

Переходим к ячейке (B1), если значение равно "№ счета" переходим к (C1), если значение не равно "№ счета", на место колонки (B) вставляем пустую колонку. По порядку перебираем ячейки (C1), (D1), (F1), (E1) и т.д. пока не найдем колонку первая ячейка которой содержит "№ счета". Вырезаем эту колонку и вставляем в пустую колонку (B).

Повторяем до тех пор, пока все колонки не займут свои места согласно шаблону (Лист 1).

Обрабатываемый файл: VB Script макрос должен находиться в одном файле-таблице вместе с шаблоном. А обрабатываемая таблица в другом файле, имя и путь которого для обработки макрос при запуске будет запрашивать.

Буду очень благодарен за любую помощь!

[Brine]

Судя по изобилию ответов на вопрос, задача либо очень простая, либо очень сложная?

Попробую разбить ее на части, может кто и поможет.

ЧАСТЬ ПЕРВАЯ

Вопрос1. Как из макроса вызвать стандартное окно открытия нового файла?

'ОКНО ВЫБОРА ИСХОДНОГО ФАЙЛА
fileToOpen = Application _
.GetOpenFilename("Excel files (*.xls)")
If fileToOpen <> False Then
MsgBox "Open " & fileToOpen
End If

Вопрос2. Как присвоить имя выбранного файла переменной?

' ПРИСВАИВАЕМ ИМЯ ФАЙЛА ПЕРЕМЕННОЙ
FileName = "Tablica.xls"

Вопрос3. Как использовать переменную хранящую имя файла для обращения к файлу в макросе?

' ДЕЛАЕМ АКТИВНЫМ ФАЙЛ, ИМЯ КОТОРОГО ХРАНИТ ПЕРЕМЕННАЯ
Windows(FileName).Activate
Sheets("Лист1").Select
Cells.Select

Вопрос4. Как слепить первых трои ответа вместе в один рабочий код?:
- вызываем окно выбора файла
- присваиваем переменной имя выбранного файла
- делаем активным окно файла, имя которого хранит переменная

[Brine]

ЧАСТЬ ВОРАЯ

Вопрос1. Как с помощью макроса проверить ячейку (A1),содержит ячейка в своем тексте, текст "п/н"?

Вопрос2. Как написать условие: Если ячейка (A1),содержит текст "п/н" переходим к (B1), иначе на место колонки (А) вставляем пустую колонку?

Вопрос3. Как найти колонку содержащую текст "Адрес", перебирая все колонки таблицы по очереди до первой пустой колонки?

Вопрос4. Как передать переменной координаты ячейки содержащей текст "Адрес"?

[Brine]

ЧАСТЬ ТРЕТЯЯ

Вопрос1. Как остановить работу макроса сообщением, и продолжить работу с места остановки после прочтения сообщения?

Вопрос2. Как в сообщение выводимое на экран в виде текста, вставить результат вычислений в макросе?

Вопрос3. Как в сообщение выводимое на экран в виде текста, вставить содержимое ячейки?

Вопрос4. Как написать макрос, добавляющий в окно сообщения две кнопки "Да" и "Нет", так, чтоб при нажатии "Да" работа продолжилась, а при нажатии "Нет" файл таблицы закрылся, без сохранения изменений?

[Казанский]

Примерно так, изучайте, пройдите по шагам (F8):

Sub Brine()
Dim r As Range, ws As Worksheet, aFldNms(), i
i = Application.GetOpenFilename("Книги Excel,*.xls*")
If i = "False" Then Exit Sub 'юзер выбрал "отмена"
        'массив заголовков полей, см. окно Locals
aFldNms = ThisWorkbook.Sheets(1).Rows(1).SpecialCells(xlCellTypeConstants).Value
With Workbooks.Open(i)
    For Each ws In .Worksheets
        ws.Activate 'только для отладки, можно удалить
        For i = 1 To UBound(aFldNms, 2)
            Set r = ws.Rows(1).Find(aFldNms(1, i), , xlValues, xlWhole)
            If r Is Nothing Then 'ячека не найдена
                ws.Activate
                MsgBox "Поле '" & aFldNms(1, i) & "' не найдено, останов.", vbCritical: Exit Sub
            ElseIf r.Column <> i Then 'перестановка столбца
                r.EntireColumn.Cut
                ws.Cells(1, i).Insert Shift:=xlToRight
            End If
        Next
    Next
    Select Case MsgBox("Столбцы успешно переставлены." & vbLf & _
        "Да - сохранить и закрыть файл," & vbLf & _
        "Нет - закрыть файл без сохранения," & vbLf & _
        "Отмена - закончить на этом", vbYesNoCancel + vbInformation)
    Case vbYes: .Close True
    Case vbNo: .Close False
    End Select
End With
End Sub

[Brine]

Код работает как швейцарские часы! Благодарю за помощь! Попробую разобраться.

[Brine]

ЧАСТЬ ПЕРВАЯ

Вопрос1. Как из макроса вызвать стандартное окно открытия нового файла?

Пример1
' С ПОМОЩЬЮ ОКНА ВЫБОРА ФАЙЛА НАЗНАЧАЕМ ПЕРЕМЕННОЙ ИМЯ ИСХОДНОГО ФАЙЛА
fileToOpen = Application _
.GetOpenFilename("Excel files (*.xls), *.xls")
If fileToOpen <> False Then
MsgBox "Open " & fileToOpen
End If

Вопрос2. Как присвоить имя выбранного файла переменной?

Пример2
' НАЗНАЧАЕМ ПЕРЕМЕННОЙ ИМЯ ИСХОДНОГО ФАЙЛА
fileToOpen = "Tablica.xls"

Вопрос3. Как использовать переменную хранящую имя файла для обращения к файлу в макросе?

Пример3
' ДЕЛАЕМ АКТИВНЫМ ФАЙЛ, ИМЯ КОТОРОГО ХРАНИТ ПЕРЕМЕННАЯ
Windows(fileToOpen).Activate
Sheets("Лист1").Select

ИЛИ

' ПРИСВАИВАЕМ ИМЯ ФАЙЛА ПЕРЕМЕННОЙ
fileToOpen = "Tablica.xls"
' ОТКРЫВАЕМ С ПОМОЩЬЮ ПЕРЕМЕННОЙ ИСХОДНЫЙ ФАЙЛ
Workbooks.Open Filename:= fileToOpen

Вопрос4. Как объединить первых три ответа вместе в один рабочий код?:
- вызываем окно выбора файла
- присваиваем переменной имя выбранного файла
- делаем активным окно файла, имя которого хранит переменная

Пример4
Sub Макрос1()

' УКАЗЫВАЕМ ПУТЬ К РАБОЧЕЙ ПАПКЕ
ChDir "C:\Проэкты VBA Script"

' ОКНО ВЫБОРА ИСХОДНОГО ФАЙЛА
fileToOpen = Application _
.GetOpenFilename("Excel files (*.xls), *.xls")
If fileToOpen <> False Then
MsgBox "Open " & fileToOpen
End If

' ДЕЛАЕМ АКТИВНЫМ ФАЙЛ, ИМЯ КОТОРОГО ХРАНИТ ПЕРЕМЕННАЯ
Windows(fileToOpen).Activate ' Вот тут и возникает ошибка!
' ПЕРЕМЕННАЯ хранит весь ПУТЬ, а не ИМЯ выбранного ФАЙЛА!
Sheets("Лист1").Select
Range("A10") = fileToOpen

End Sub

Вопрос5. Пусть переменная fileToOpen равна пути C:\Проэкты VBA Script\Tablica.xls Как от переменной fileToOpen содержащей путь C:\Проэкты VBA Script\Tablica.xls отделить имя файла Tablica.xls и назначить другой переменной fileNameToOpen?

[Казанский]

А каков смысл этого действия? Вы хотите проверить, не открыт ли уже этот файл?
Тогда лучше замените

With Workbooks.Open(i)

на

With GetObject(i)
    .Windows(1).Activate 'только для отладки

Если файл уже открыт, код будет работать с ним. Если нет - откроет.