Запрос диалогового окна выбора excel файла [Версия для КПК]

storm_Zcooler

29-08-2012, 11:55

Доброго времени суток!!!

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

Iska

29-08-2012, 13:16

Например, так:
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

Спасибо огромное!!!

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

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

Iska

30-08-2012, 05:04

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

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

storm_Zcooler

30-08-2012, 05:51

Прикладываю два файла исходный и результирующий, ячейки откуда и куда выделены соответствующими цветами.

Iska

30-08-2012, 08:49

Примерно так:
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
есть запись, но там ячейки объеденены, »
Тут сие роли не играет, поскольку мы просто берём значение из ячейки. Обращаемся к диапазону по имени («TTNNum»).

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

storm_Zcooler

31-08-2012, 06:34

Если у меня в исходном файле ячейка называется 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

а если у меня просто ячейка 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

Спасибо тебе огромное, но у меня еще вопрос, обновил файлы!

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

Iska

03-09-2012, 19:18

storm_Zcooler, изложенное Вами задание мне не понятно. Попробуйте уточнить более детально.

storm_Zcooler

04-09-2012, 05:15

ок. Давайте по порядку.

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

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

Iska

04-09-2012, 09:35

storm_Zcooler, использование запятых в предложениях облегчит понимание собеседнику.

storm_Zcooler

04-09-2012, 11:04

Спасибо за помощь закрываем тему там на самом деле всё гораздо сложней чем казалось изначально...

storm_Zcooler

07-09-2012, 11:58

Как сделать в примере, чтобы числа во втором столбце, через запятую, опустились ниже на ячейку, и остальные данные, которые в этой же строке скопировались так же вниз. На примере думаю видно.

Iska

07-09-2012, 14:29

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

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

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

Iska

11-09-2012, 01:24

а справа только в 1 раз оставались. »
Удалите или закомментируйте ненужные присвоения:
.Offset(XXX, XXX).Value = …

2003: Offset Property [Excel 2003 VBA Language Reference] (http://msdn.microsoft.com/en-us/library/office/aa224911(v=office.11).aspx)
2007: Offset Property (http://msdn.microsoft.com/en-us/library/office/bb213689(v=office.12).aspx)
2010: Offset Property (http://msdn.microsoft.com/en-us/library/office/ff840060.aspx)

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

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

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

storm_Zcooler

11-09-2012, 05:28

а справа только в 1 раз оставались. »
Удалите или закомментируйте ненужные присвоения:
Код:
.Offset(XXX, XXX).Value = … »

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

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

Iska

11-09-2012, 06:45

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

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