Компьютерный форум OSzone.net  

Компьютерный форум OSzone.net (http://forum.oszone.net/index.php)
-   Программирование и базы данных (http://forum.oszone.net/forumdisplay.php?f=21)
-   -   Запрос диалогового окна выбора excel файла (http://forum.oszone.net/showthread.php?t=241596)

storm_Zcooler 29-08-2012 11:55 1979121
Запрос диалогового окна выбора excel файла
 
Доброго времени суток!!!

Помогите со скриптом. Есть Excel файл, нужно по нажатию кнопки выходило диалоговое окно выбора excel файла из которого копируется определённый диапазон с данными и вставляется в текущий. Заранее спасибо.

Iska 29-08-2012 13:16 1979164
Например, так:
читать дальше »
Код:
Option Explicit

Sub Sample()
    Dim i As Long
    Dim objRange As Range

    With Application.FileDialog(msoFileDialogOpen)
        With .Filters
            .Clear
            .Add "Microsoft Excel Workbooks", "*.xls"
            .Add "All files", "*.*"
        End With
       
        .AllowMultiSelect = False
        .InitialView = msoFileDialogViewDetails
       
        If Not .Show() = 0 Then
            For i = 1 To .SelectedItems.Count
                Set objRange = Selection
               
                With Application.Workbooks.Open(.SelectedItems.Item(i))
                    .Sheets.Item("Лист1").Range("b3:c8").Copy
                   
                    With ThisWorkbook.Sheets.Item("Лист1")
                        .Paste objRange
                    End With
                   
                    Application.CutCopyMode = False
                    .Close
                End With
               
                Exit For
            Next i
        End If
    End With
End Sub

storm_Zcooler 29-08-2012 13:49 1979188
Спасибо огромное!!!

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

еще вопрос в файле из которого импортируется есть ячейка там указаны размеры например 100Х300Х100 (указаны в см) можно ли при импорте разбить эти данные в три разные ячейки и перевести их в метры.

Iska 30-08-2012 05:04 1979597
Цитата:
Цитата storm_Zcooler
А можно ли сделать так в том файле из которого импортируется даные есть запись, но там ячейки объеденены, а надо чтобы скопировал эту запись и вставил в другой файл в одну ячейку? »
Поясните приложенными примерами документов с подробными пояснениями.

Цитата:
Цитата storm_Zcooler
еще вопрос в файле из которого импортируется есть ячейка там указаны размеры например 100Х300Х100 (указаны в см) можно ли при импорте разбить эти данные в три разные ячейки и перевести их в метры. »
Можно. Точно так же: выложите примеры документов — исходного и результирующего.

storm_Zcooler 30-08-2012 05:51 1979607
Вложений: 2
Прикладываю два файла исходный и результирующий, ячейки откуда и куда выделены соответствующими цветами.

Iska 30-08-2012 08:49 1979639
Примерно так:
Код:
Sub Sample2()
    Dim objWorksheet As Worksheet
   
    Dim i As Long
    Dim elem As Variant
   
   
    Set objWorksheet = ThisWorkbook.Sheets.Item("Лист1")
   
    With Application.Workbooks.Open("E:\Песочница\0172\исходный.xls")
        objWorksheet.Range("A4").Value = .Names.Item("TTNNum").RefersToRange.Value
       
        i = 1
       
        For Each elem In Split(.Sheets.Item("сторона 1").Range("L9").Value, "x")
            objWorksheet.Range("F4").Item(1, i).Value = CLng(elem) / 1000
           
            i = i + 1
        Next
       
        .Close
    End With
   
    Set objWorksheet = Nothing
End Sub
Цитата:
Цитата storm_Zcooler
есть запись, но там ячейки объеденены, »
Тут сие роли не играет, поскольку мы просто берём значение из ячейки. Обращаемся к диапазону по имени («TTNNum»).

Цитата:
Цитата storm_Zcooler
есть ячейка там указаны размеры например 100Х300Х100 (указаны в см) можно ли при импорте разбить эти данные в три разные ячейки и перевести их в метры. »
Насколько я понимаю — либо размеры в мм (а не в см), либо пример Вы привели неверный. Аналогично — читаем значение ячейки по адресу, разбиваем по символу «x» в массив, затем заполняем целевые ячейки, просто перебирая элементы массива.

storm_Zcooler 31-08-2012 06:34 1980274
Если у меня в исходном файле ячейка называется TTNNum то код получается
objWorksheet.Range("H9").Value = .Names.Item("TTNNum").RefersToRange.Value
а если у меня просто ячейка C9
objWorksheet.Range("H9").Value = .Names.Item("С9").RefersToRange.Value
выдает ошибку....

Iska 31-08-2012 07:10 1980279
Цитата:
Цитата storm_Zcooler
а если у меня просто ячейка C9 »
.Names — это коллекция имёнованных диапазонов. «C9» — это не именованный диапазон, а адрес ячейки. Смотрите в том же макросе двумя строчками ниже:
Код:
… .Sheets.Item("сторона 1").Range("L9").Value …
и делайте так же. Например:
Код:
objWorksheet.Range("H9").Value = .Sheets.Item("сторона 1").Range("C9").Value

storm_Zcooler 03-09-2012 03:38 1981947
Вложений: 2
Спасибо тебе огромное, но у меня еще вопрос, обновил файлы!

В исходном файле есть "вид упаковки"(Pallet #1) это площадка, на ней стоят коробки, количество площадок и количество коробок не постоянное и может меняться. Как сделать цикл так чтобы во первых скопировав одну строку проверял есть ли данные в другой если есть то копировал их.
Во вторых надо сделать чтобы ккопировал данные которые Pallet #1 потом отделял их толстой линией, и потом копивал данные которые Pallet #2 и т.д. соответственно ячейки Размеры грузовых мест и Масса (кг).

Iska 03-09-2012 19:18 1982317
storm_Zcooler, изложенное Вами задание мне не понятно. Попробуйте уточнить более детально.

storm_Zcooler 04-09-2012 05:15 1982569
ок. Давайте по порядку.

В исходном файле есть диапазон с9:с17(это коробки), этот диапазон не постоянен может быть больше коробок может быть меньше, этот диапазон определяется объединением ячеек J9(Pallet #1 это площадка на которой размещаются эти коробки). Как можно сделать чтобы копировались данные (коробки которые стоят на площадке Pallet #1) только которые в диапазоне объединения ячеек J9.

наверное опять не понятно сказал =)

Iska 04-09-2012 09:35 1982646
storm_Zcooler, использование запятых в предложениях облегчит понимание собеседнику.

storm_Zcooler 04-09-2012 11:04 1982692
Спасибо за помощь закрываем тему там на самом деле всё гораздо сложней чем казалось изначально...

storm_Zcooler 07-09-2012 11:58 1984672
Вложений: 1
Как сделать в примере, чтобы числа во втором столбце, через запятую, опустились ниже на ячейку, и остальные данные, которые в этой же строке скопировались так же вниз. На примере думаю видно.

Iska 07-09-2012 14:29 1984765
storm_Zcooler, примерно так:
читать дальше »
Код:
Option Explicit

Sub SomeSample()
    Dim objRange As Range
   
    Dim i As Long
    Dim j As Long
   
    Dim arrValues() As String
   
   
    With Selection.Cells
        For i = .Count To 1 Step -1
            With .Item(i)
                arrValues = Split(.Value, ",")
               
                For j = UBound(arrValues) To LBound(arrValues) Step -1
                    .EntireRow.Offset(1).Insert
                   
                    .Offset(1, 0).Value = arrValues(j)
                    .Offset(1, -1).Value = .Offset(0, -1).Value
                    .Offset(1, 1).Value = .Offset(0, 1).Value
                    .Offset(1, 2).Value = .Offset(0, 2).Value
                Next
               
                .EntireRow.Delete
            End With
        Next
    End With
End Sub

Перед исполнением макроса необходимо выделить потребный диапазон со значениями. В Вашем примере это «B2:B4».

А вообще, какое отношение теперешний вопрос имеет к озвученной теме — «Запрос диалогового окна выбора excel файла»?

storm_Zcooler 10-09-2012 13:31 1986101
Вложений: 1
Приветствую, спасибо за советы но вот задачка немного изменилась, надо чтобы значения после запятой опускались вниз и всё что слева тоже копировались, а справа только в 1 раз оставались. Прикладываю файл там думаю понятней будет.

P.S. у тебя есть яндекс кошелек? Отблагодарю.

Iska 11-09-2012 01:24 1986441
Цитата:
Цитата storm_Zcooler
а справа только в 1 раз оставались. »
Удалите или закомментируйте ненужные присвоения:
Код:
.Offset(XXX, XXX).Value = …
2003: Offset Property [Excel 2003 VBA Language Reference]
2007: Offset Property
2010: Offset Property

Впрочем, никакой разницы по версиям нет. Ну, да ладно.

Цитата:
Цитата storm_Zcooler
P.S. у тебя есть яндекс кошелек? »
Нет. Обычного, впрочем, тоже нет.

Цитата:
Цитата storm_Zcooler
Отблагодарю. »
Попробуйте обратиться к Администрации, может им сгодится.

storm_Zcooler 11-09-2012 05:28 1986467
Вложений: 1
Цитата:
Цитата Iska
а справа только в 1 раз оставались. »
Удалите или закомментируйте ненужные присвоения:
Код:
.Offset(XXX, XXX).Value = … »

Если её удаляю, то значения не будут копироваться вообще, а мне надо только, чтобы в первая строка копировалась полностью, а ниже добавлялись строки со значениями, которые отделяются запятой и всё, что справа было от них, а слева было пусто.

Обновил пример во вложении, может так наглядней будет.

Iska 11-09-2012 06:45 1986476
storm_Zcooler, не доглядел с первого раза, не понял до конца Вашей потребности. Приношу Вам свои извинения.

Значит, будет достаточно проверять счётчик и на последнем проходе цикла разбора дублировать и ячейки справа, наподобие:
читать дальше »
Код:
Option Explicit

Sub SomeSample()
    Dim objRange As Range
   
    Dim i As Long
    Dim j As Long
   
    Dim arrValues() As String
   
   
    With Selection.Cells
        For i = .Count To 1 Step -1
            With .Item(i)
                arrValues = Split(.Value, ",")
               
                For j = UBound(arrValues) To LBound(arrValues) Step -1
                    .EntireRow.Offset(1).Insert
                   
                    .Offset(1, 0).Value = arrValues(j)
                   
                    .Offset(1, -4).Value = .Offset(0, -4).Value
                    .Offset(1, -3).Value = .Offset(0, -3).Value
                    .Offset(1, -2).Value = .Offset(0, -2).Value
                    .Offset(1, -1).Value = .Offset(0, -1).Value
                   
                    If j = LBound(arrValues) Then
                        .Offset(1, 1).Value = .Offset(0, 1).Value
                        .Offset(1, 2).Value = .Offset(0, 2).Value
                        .Offset(1, 3).Value = .Offset(0, 3).Value
                        .Offset(1, 4).Value = .Offset(0, 4).Value
                    End If
                Next
               
                .EntireRow.Delete
            End With
        Next
    End With
End Sub

Или вовсе на последнем проходе новую строку не добавлять, саму оригинальную строку не удалять, а просто менять значение разбираемой ячейки на последнее значение разбора:
читать дальше »
Код:
Option Explicit

Sub SomeSample()
    Dim objRange As Range
   
    Dim i As Long
    Dim j As Long
   
    Dim arrValues() As String
   
   
    With Selection.Cells
        For i = .Count To 1 Step -1
            With .Item(i)
                arrValues = Split(.Value, ",")
               
                For j = UBound(arrValues) To LBound(arrValues) Step -1
                    If j = LBound(arrValues) Then
                        .Value = arrValues(j)
                    Else
                        .EntireRow.Offset(1).Insert
                       
                        .Offset(1, 0).Value = arrValues(j)
                       
                        .Offset(1, -4).Value = .Offset(0, -4).Value
                        .Offset(1, -3).Value = .Offset(0, -3).Value
                        .Offset(1, -2).Value = .Offset(0, -2).Value
                        .Offset(1, -1).Value = .Offset(0, -1).Value
                    End If
                Next
            End With
        Next
    End With
End Sub

Думаю, так даже лучше будет.


Время: 16:25.

Время: 16:25.
© OSzone.net 2001-