Гость
Целевая тема:
Создать новую тему:
Автор:
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Загрузка файлов в Excel / 25 сообщений из 28, страница 1 из 2
23.09.2009, 14:08:21
    #36212585
Joris
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Загрузка файлов в Excel
Привет всем!!!
в VBA нету опыто из форума нашел кое что для загрузка файлов.., зада стоит в том что есть xls или txt файлов их надо загружать в основной файл Excel который состои из список клиентов. Работает в роде но неэфективно и медленно есть какой небуд другой способ???

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
Sub WU_Êíîïêà1_Ùåëêíóòü()
  Dim i As Integer
  Dim j As Integer
  Dim MySheet As Worksheet
  Dim MySheet1 As Worksheet
  Dim TxtFileName As Variant
  Dim TxtBook As Workbook
  
  Set MySheet = ActiveSheet
  
  TxtFileName = Application.GetOpenFilename("Microsoft Office Excel (*.xls), *.xls")
  
  If TxtFileName <> False Then
  
    Workbooks.OpenText Filename:=TxtFileName _
                                , Origin:=xlWindows _
                                , DataType:=xlDelimited _
                                , Other:=True, OtherChar:=";"
    Set TxtBook = Workbooks(Workbooks.Count)
    
    'MsgBox ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count
    
    'MsgBox TxtFileName
    
    If Mid(TxtFileName,  8 ,  2 ) = "01" Then
    
        For i =  6  To  195  'ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count
            For j =  6  To  125  'ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count
                If TxtBook.Worksheets( 1 ).Range("B" & (j)) = MySheet.Range("B" & (i)) Then
                        TxtBook.Worksheets( 1 ).Range("C" & (j)) = -(TxtBook.Worksheets( 1 ).Range("D" & (j)) + TxtBook.Worksheets( 1 ).Range("E" & (j)))
                        TxtBook.Worksheets( 1 ).Range("N" & (j)) = -(TxtBook.Worksheets( 1 ).Range("O" & (j)) + TxtBook.Worksheets( 1 ).Range("P" & (j)))
                        TxtBook.Worksheets( 1 ).Range("C" & (j)).Select
                        Selection.Copy
                        MySheet.Paste Destination:=MySheet.Range("C" & (i))
                        TxtBook.Worksheets( 1 ).Range("N" & (j)).Select
                        Selection.Copy
                        MySheet.Paste Destination:=MySheet.Range("D" & (i))
                Else
                        MySheet.Range("C" & (i)).Select
                        Selection.Copy
                        MySheet.Paste Destination:=MySheet.Range("C" & (i))
                End If
            Next
        Next
    End If
    
    TxtBook.Saved = True
    TxtBook.Close
    
End If
End Sub
...
Рейтинг: 0 / 0
23.09.2009, 16:05:57
    #36212980
big-duke
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Загрузка файлов в Excel
Joris,

для начала Application.ScreenUpdating=false и отключить авторасчет формул, если они есть.
...
Рейтинг: 0 / 0
23.09.2009, 17:58:14
    #36213305
Hugo121
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Загрузка файлов в Excel
Попробуй такой вариант, я в 46 сек. уложился (на почти пустом правда файле):
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
Sub WU_Eiiiea1_Uaeeioou()
  Dim i As Integer
  Dim j As Integer
  Dim MySheet As Worksheet
  Dim MySheet1 As Worksheet
  Dim TxtFileName As Variant
  Dim TxtBook As Workbook
  Application.ScreenUpdating = False
  Set MySheet = ActiveSheet
  
  TxtFileName = Application.GetOpenFilename("TXT For Microsoft Office Excel (*.txt), *.txt")
  
  If TxtFileName <> False Then
  
    Workbooks.OpenText Filename:=TxtFileName _
                                , Origin:=xlWindows _
                                , DataType:=xlDelimited _
                                , Other:=True, OtherChar:=";"
    Set TxtBook = Workbooks(Workbooks.Count)
    
    'MsgBox ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count
    
    'MsgBox TxtFileName
    
    If Mid(TxtFileName,  8 ,  2 ) = "01" Then
    
        For i =  6  To  195  'ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count
            For j =  6  To  125  'ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count
                If TxtBook.Worksheets( 1 ).Range("B" & (j)) = MySheet.Range("B" & (i)) Then
                        TxtBook.Worksheets( 1 ).Range("C" & (j)) = -(TxtBook.Worksheets( 1 ).Range("D" & (j)) + TxtBook.Worksheets( 1 ).Range("E" & (j)))
                        TxtBook.Worksheets( 1 ).Range("N" & (j)) = -(TxtBook.Worksheets( 1 ).Range("O" & (j)) + TxtBook.Worksheets( 1 ).Range("P" & (j)))
                        TxtBook.Worksheets( 1 ).Range("C" & (j)).Copy MySheet.Range("C" & (i))
                        TxtBook.Worksheets( 1 ).Range("N" & (j)).Copy MySheet.Range("D" & (i))
                Else
                        MySheet.Range("C" & (i)).Copy MySheet.Range("C" & (i))
                End If
                x =  195  +  6  - i
                
                Application.StatusBar = "Wait:  " & x    ' Это для визуализации работы макроса

            Next
        Next
    End If
    
     Application.StatusBar = False
     Application.ScreenUpdating = True
    
    TxtBook.Saved = True
    TxtBook.Close

End If
End Sub


Чуть переделал копирование и выбор - только тхт файлы, если не надо, поменяй назад.
...
Рейтинг: 0 / 0
24.09.2009, 12:01:36
    #36214553
Joris
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Загрузка файлов в Excel
Спасибо нормально работает, еще вопрос в файле все нарисована:
...
Рейтинг: 0 / 0
24.09.2009, 12:05:44
    #36214570
Hugo121
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Загрузка файлов в Excel
И какой вопрос?
...
Рейтинг: 0 / 0
24.09.2009, 12:15:05
    #36214605
Joris
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Загрузка файлов в Excel
ага, вопрос как это организоват, пока несоображаю в макросах знаком конечно но не да токого степена...
...
Рейтинг: 0 / 0
24.09.2009, 12:36:09
    #36214671
Hugo121
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Загрузка файлов в Excel
Организовать что?
...
Рейтинг: 0 / 0
24.09.2009, 13:09:05
    #36214753
Joris
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Загрузка файлов в Excel
Значить я непонятно говорю, есть текстовый файл Test.txt загружать его в Exel и получит вот такой Test.xls
...
Рейтинг: 0 / 0
24.09.2009, 13:09:46
    #36214759
Joris
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Загрузка файлов в Excel
Текстовый файл
...
Рейтинг: 0 / 0
24.09.2009, 13:10:52
    #36214762
Joris
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Загрузка файлов в Excel
Экселовский файл
...
Рейтинг: 0 / 0
24.09.2009, 13:18:48
    #36214793
Hugo121
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Загрузка файлов в Excel
Теперь понятно. Сделать можно, но пока не вижу, как лучше... Анализировать это текстовик можно и vbs скриптом, затем результат грузить в форму или генерить новый xls файл... А можно и всё делать в Экселе. На досуге попробую.
...
Рейтинг: 0 / 0
24.09.2009, 17:02:37
    #36215573
Hugo121
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Загрузка файлов в Excel
Кстати, почему так:
Код: plaintext
1.
Камилов Д.Ю.; 10250  
Камилов Д.Ю.;; 103 . 26 
то одна, то две ;
косяк или надо обрабатывать?
...
Рейтинг: 0 / 0
25.09.2009, 07:46:19
    #36216404
Joris
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Загрузка файлов в Excel
Hugo121Кстати, почему так:
Код: plaintext
1.
Камилов Д.Ю.; 10250  
Камилов Д.Ю.;; 103 . 26 
то одна, то две ;
косяк или надо обрабатывать?
Разделитель только одно две неможет быть а в файле по ощибку они попали....
...
Рейтинг: 0 / 0
25.09.2009, 09:35:43
    #36216516
Hugo121
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Загрузка файлов в Excel
Учти, я делаю на основе приложенного файла, так что если на оригинале работать не будет, вини себя.
Две ; уже обработал, если гарантируешь, что эта ошибка не повторится, из кода уберу.
Почему на евро нет идентификатора? Так и есть, или это тоже ошибка?
...
Рейтинг: 0 / 0
25.09.2009, 10:38:39
    #36216642
Hugo121
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Загрузка файлов в Excel
Так, сделал в первом приближении. Это скрипт vbs , грузит текстовый файл из c:\temp\Test.txt
Нулей и форматирования в Экселе пока нет, пока не думал, как это сделать.
Но всё вроде работает, потести на рабочем файле.

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
Dim i
Dim x
Dim nmArray()
Dim eurArray()
Dim usdArray()
Dim rubArray()

Const ForReading =  1 

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFSO.OpenTextFile _
    ("c:\temp\Test.txt", ForReading)
	
ReDim nmArray( 0 )
ReDim eurArray( 0 )
ReDim usdArray( 0 )
ReDim rubArray( 0 )

Do Until objTextFile.AtEndOfStream
    strNextLine = objTextFile.Readline
    'strNextLine = Replace(strNextLine, ".", ",")  'раскомментировать, если разделитель дробной части в системе ","
    strNextLine = Replace(strNextLine, ";;", ";")  'закомментировать, если ошибок с ";;" больше не будет
    arrLineList = Split(strNextLine , ";")
    x= 0 
	flag =  0 

	For i =  0  To UBound(nmArray)
        If nmArray(i) = arrLineList( 0 ) Then
		 flag =  1  ' takoe znacenie uze estj
		 x=i
		End if
    Next
	
	If flag =  0  Then
		ReDim Preserve nmArray(UBound(nmArray) +  1 )
		nmArray(UBound(nmArray)) = arrLineList( 0 ) ' zanosim v massiv
		x = UBound(nmArray)
	End if
	
	if Right(arrLineList( 1 ),  1 )="$" then 
		ReDim Preserve usdArray(x)
		If flag =  0  Then
		usdArray(UBound(usdArray)) = CDbl(Trim(Left(arrLineList( 1 ), Len(arrLineList( 1 ))- 1 )))
		Else
		usdArray(x) = CDbl(usdArray(x)) + CDbl(Trim(Left(arrLineList( 1 ), Len(arrLineList( 1 ))- 1 )))
		End If
	end If

	If IsNumeric(Right(arrLineList( 1 ),  1 )) then
		ReDim Preserve eurArray(x)		
		If flag =  0  Then
		eurArray(UBound(eurArray)) = CDbl(Trim(arrLineList( 1 )))
		Else
		eurArray(x) = eurArray(x) + CDbl(Trim(arrLineList( 1 )))
		End If
	End If

	if Right(arrLineList( 1 ),  1 )="." then 
		ReDim Preserve rubArray(x)		
		If flag =  0  Then
		rubArray(UBound(rubArray)) = CDbl(Trim(Left(arrLineList( 1 ), Len(arrLineList( 1 ))- 4 )))
		Else
		rubArray(x) = CDbl(rubArray(x)) + CDbl(Trim(Left(arrLineList( 1 ), Len(arrLineList( 1 ))- 4 )))
		End If
	end If

	
Loop

objTextFile.Close

Set objExcel = CreateObject("Excel.Application")

objExcel.Visible = True
objExcel.Workbooks.Add
objExcel.Cells( 1 ,  1 ).Value = "Клиент"
objExcel.Cells( 1 ,  2 ).Value = "Доллар"
objExcel.Cells( 1 ,  3 ).Value = "Рос."
objExcel.Cells( 1 ,  4 ).Value = "Евро"

For ex =  1  To UBound(nmArray)
	objExcel.Cells(ex+ 1 ,  1 ).Value = nmArray(ex)
	objExcel.Cells(ex+ 1 ,  2 ).Value = usdArray(ex)
	objExcel.Cells(ex+ 1 ,  3 ).Value = rubArray(ex)
	objExcel.Cells(ex+ 1 ,  4 ).Value = eurArray(ex)
Next

Спецы в vbs, покритикуйте, пожалуйста, я в этом деле новичёк.
...
Рейтинг: 0 / 0
25.09.2009, 10:50:55
    #36216669
Hugo121
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Загрузка файлов в Excel
Чёрт, сейчас только заметил - если заменить "." на ",", то не будут находится рубли (они определяются по точке в слове "руб.".
Переделал, теперь привязка к "б" - см. новый аттачмент.
...
Рейтинг: 0 / 0
25.09.2009, 13:09:45
    #36217065
Joris
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Загрузка файлов в Excel
Hugo121 спасибо, щяс пробую ...
...
Рейтинг: 0 / 0
25.09.2009, 13:32:34
    #36217121
Joris
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Загрузка файлов в Excel
Hugo121Почему на евро нет идентификатора? Так и есть, или это тоже ошибка?
нет это не ощибка евро без идентификатора
...
Рейтинг: 0 / 0
25.09.2009, 13:44:26
    #36217172
Hugo121
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Загрузка файлов в Excel
Добавил пропуск строки, если в ней нет ";" (раньше выкидывало в этом случае) и немного форматирования.
...
Рейтинг: 0 / 0
25.09.2009, 16:25:12
    #36217835
Hugo121
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Загрузка файлов в Excel
Добавил диалог открытия файла (по умолчанию objDialog.InitialDir = "C:\" , откорректируй под себя).
Немного переформатировал код с помощью ":', так короче выглядит, да и работает наверное быстрее....
...
Рейтинг: 0 / 0
25.09.2009, 17:43:47
    #36218087
Hugo121
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Загрузка файлов в Excel
Вышла новая версия :)
Поменял формат переменных с CDbl на CCur. Вроде так правильнее... Но CCur округляет до 4 знаков после запятой, хотя в данном примере и этого много.
Побочное явление - ячейки Экселя автоматом приняли денежный формат, и почему-то все долларовый :)
Прошлось насильно менять на числовой с двумя знаками после разделителя (NumberFormat = "#,##0.00_);(#,##0.00)").
Знатоки, поясните пожалуйста, в чём плюс или минус CDbl vs CCur.
...
Рейтинг: 0 / 0
25.09.2009, 22:01:39
    #36218432
Hugo121
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Загрузка файлов в Excel
Немного подправил -
1. При замене разделителя точки подменялись на запятые и в клиентах - fixed (потом меняю назад)
2. Теперь каталог по умолчанию тот, который был в предыдущий раз - легче тестить :) (или это только у меня система запоминает? )

Вопрос к спецам - не покажете, как на 4-хмерном массиве сделать, что-то запутался в синтаксисе совсем, не получается такой вариант.
И как определить автоматически тип разделителя дробной части в системе?
...
Рейтинг: 0 / 0
26.09.2009, 20:39:56
    #36219005
Hugo121
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Загрузка файлов в Excel
Чисто в целях изучения - сделал на одном массиве (4 группы, количество элементов динамическое). Поиск в Google по " vbs multidimension array " ничего дельного не принёс, сам копал... поэтому здесь эти слова и написал :) , может кому пригодится.
Формат переменных всё же поменял назад на CDbl.
Прокомментировал код, как смог.
Пытался внизу подбить итог - формула вставляется, но не считает, пока не зайдёшь в её редактирование... Как победить в vbs? Экселевские способы не срабатывают.
И ещё - как прикрутить индикатор работы какой-нибудь?

У меня самого похожая работа бывает, хочу использовать, раз уж вник. Так удобнее, чем всё в Экселе делать.
...
Рейтинг: 0 / 0
26.09.2009, 22:18:04
    #36219038
Hugo121
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Загрузка файлов в Excel
Добавил автоматическое определение десятичного разделителя.
...
Рейтинг: 0 / 0
28.09.2009, 09:31:29
    #36219786
Hugo121
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Загрузка файлов в Excel
Hugo121.
Пытался внизу подбить итог - формула вставляется, но не считает, пока не зайдёшь в её редактирование... - считает, только надо формулу писать английскую :)
...
Рейтинг: 0 / 0
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Загрузка файлов в Excel / 25 сообщений из 28, страница 1 из 2
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]