powered by simpleCommunicator - 2.0.59     © 2025 Programmizd 02
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / macros -- данные из csv файла надо вставить в Excel
25 сообщений из 39, страница 1 из 2
macros -- данные из csv файла надо вставить в Excel
    #36572365
sasha2345
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Есть большой macros где данные из csv файла надо вставить в Excel
Мне надо дописать маленькую часть где:
если есть TOTAL OTHER REVENUE тогда оставить и OTHER REVENUE
если нет TOTAL OTHER REVENUE тогда удалить OTHER REVENUE

Вот пишу так, но почему-то OTHER REVENUE всегда удаляется -- когда есть TOTAL OTHER REVENUE и когда его нет.





Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
  
 i =  5 
      Do
  If Mid(Cells(i,  8 ),  1 ,  19 ) <> "TOTAL OTHER REVENUE" Then
 
             If Mid(Cells(i,  8 ),  1 ,  13 ) = "OTHER REVENUE" Then
                    Call DeleteRow(CStr(i) + ":" + CStr(i))
             End If

  End If


  i = i +  1 
Loop Until i = iRows
...
Рейтинг: 0 / 0
macros -- данные из csv файла надо вставить в Excel
    #36572370
sasha2345
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
это образец csv файла когда есть TOTAL OTHER REVENUE:


Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
	RESIDENTAL RENT	
- 1 . 8 	Residential Rent-Stabilized	             - 1192865 
 26 . 3 	Residential Rent-DeStabilized	- 1193052 
 11 . 7 	TOTAL RESIDENTAL RENT	             - 2385917 
	RENT REVENUE	
 11 . 7 	Total Residental Rent	             - 2385917 
 3 	Commercial Rent	                          - 108643 
 11 . 4 	TOTAL RENT REVENUE              	- 2494560 
	OTHER REVENUE	
 [b]61 	Other Revenue	                            45 
 15 	TOTAL OTHER REVENUE                      12 [/b]
	TENNANT FEES	
- 9 . 8 	Late Fees	                          - 34639 
 132 . 4 	Administrative Fees	             - 1272 
 0 	Security Deposit Admin Fee	             - 3613 
 100 	Termination/Surrender Fees   	- 3800 




это образец csv файла когда нет TOTAL OTHER REVENUE и тогда надо удалить OTHER REVENUE

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
	RESIDENTAL RENT	
- 1 . 8 	Residential Rent-Stabilized	             - 1192865 
 26 . 3 	Residential Rent-DeStabilized	- 1193052 
 11 . 7 	TOTAL RESIDENTAL RENT	             - 2385917 
	RENT REVENUE	
 11 . 7 	Total Residental Rent	             - 2385917 
 3 	Commercial Rent	                          - 108643 
 11 . 4 	TOTAL RENT REVENUE              	- 2494560 
	OTHER REVENUE	
	TENNANT FEES	
- 9 . 8 	Late Fees	                          - 34639 
 132 . 4 	Administrative Fees	             - 1272 
 0 	Security Deposit Admin Fee	             - 3613 
 100 	Termination/Surrender Fees   	- 3800 
...
Рейтинг: 0 / 0
macros -- данные из csv файла надо вставить в Excel
    #36572431
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Ваш кусок настолько вырван из контекста, что не подлежит анализу.

Поставьте точку останова на условиях и распечатайте значения выражений с MID
...
Рейтинг: 0 / 0
macros -- данные из csv файла надо вставить в Excel
    #36572438
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
sasha2345,
у Вас ведь цикл идёт сверху, и в любом случае сперва удалит OTHER REVENUE, а лишь затем обнаружит TOTAL OTHER REVENUE.
Я думаю, есть 3 варианта (лучший 3-ий):
1.если TOTAL OTHER REVENUE всегда ниже, то цикл надо вести снизу и выходить из цикла при нахождении.
2. если TOTAL OTHER REVENUE всегда ниже, то цикл надо вести снизу и использовать флаг.
Т.е. если нашли тотал - ставим флаг = true, и тогда удаление не сработает (проверять флаг перед удалением.
3. Использовать find по этому столбцу. Если TOTAL OTHER REVENUE не нашлось - запускаем цикл перебора сторок, или даже так же через find ищем строку с OTHER REVENUE и удаляем.
Т.е. дословно Ваше условие:
Код: plaintext
1.
если есть TOTAL OTHER REVENUE тогда оставить и OTHER REVENUE
если нет TOTAL OTHER REVENUE тогда удалить OTHER REVENUE
...
Рейтинг: 0 / 0
macros -- данные из csv файла надо вставить в Excel
    #36572441
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Hugo121у Вас ведь цикл идёт сверху, и в любом случае сперва удалит OTHER REVENUE, а лишь затем обнаружит TOTAL OTHER REVENUE.

Хьюго, почему?
Он же Mid-ом режет строку (можно использовать Left, кстати), так что не должен.
...
Рейтинг: 0 / 0
macros -- данные из csv файла надо вставить в Excel
    #36572446
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Shocker.Pro,
я так прочитал:
идёт по строкам вниз, начиная с 5-ой, и если в начале 8-ой ячейки нет "TOTAL OTHER REVENUE", то удаляет эту строку, если в ней в начале есть "OTHER REVENUE".
Т.е. в любом случае эту строку удалит.
...
Рейтинг: 0 / 0
macros -- данные из csv файла надо вставить в Excel
    #36572461
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Ну вот например так, если в этом листе в 8-ом столбце только одно возможное значение "TOTAL OTHER REVENUE" и "OTHER REVENUE"
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
Sub tt()
Set X = Columns( 8 ).Find(What:="TOTAL OTHER REVENUE", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
If X Is Nothing Then
    Set X = Columns( 8 ).Find(What:="OTHER REVENUE", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
        If Not X Is Nothing Then
        Rows(X.Row).EntireRow.Delete
        End If
End If
End Sub
...
Рейтинг: 0 / 0
macros -- данные из csv файла надо вставить в Excel
    #36572557
sasha2345
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Hugo121,

Спасибо! Работает!
...
Рейтинг: 0 / 0
macros -- данные из csv файла надо вставить в Excel
    #36572570
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
sasha2345, смотри, это только на одно совпадение! Если будет больше, уже второе не удалит!
И может ещё LookAt:=xlWhole, MatchCase:=False можно поменять... мало ли там пробелы... И диапазон поиска можно сузить, если там например на одном листе несколько таких списков есть - можно перебрать их по-отдельности.
...
Рейтинг: 0 / 0
macros -- данные из csv файла надо вставить в Excel
    #36572650
sasha2345
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Hugo121,

подскажите как если в колонке 8 встречается : Mid(Cells(i, 8), 1, 5) = "TOTAL" то тогда после этой строчки вставлять пустую?
...
Рейтинг: 0 / 0
macros -- данные из csv файла надо вставить в Excel
    #36572651
zchvv
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Код: plaintext
rows(c.row+ 1 ).Insert

где c - ячейка с выполняющимся условием
...
Рейтинг: 0 / 0
macros -- данные из csv файла надо вставить в Excel
    #36572709
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
sasha2345Hugo121,

подскажите как если в колонке 8 встречается : Mid(Cells(i, 8), 1, 5) = "TOTAL" то тогда после этой строчки вставлять пустую?

Уже подсказали, но есть одно недосказанное, что может вдруг неожиданно проявиться:
Код: plaintext
1.
2.
3.
4.
5.
Sub ttt()
For i =  16  To  1  Step - 1 
If Mid(Cells(i,  8 ),  1 ,  5 ) = "TOTAL" Then Rows(i +  1 ).Insert
Next
End Sub
Вот именно так, снизу вверх. Потому что иначе последний "TOTAL" может оказаться (после добавления строк) например на строке 17, и проверен уже не будет.
...
Рейтинг: 0 / 0
macros -- данные из csv файла надо вставить в Excel
    #36572810
sasha2345
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Hugo121,

что-то после того как я хочу вставить пустую строчку весь макро не работает так как работал до вставки.

и не важно как пишу, так


Код: plaintext
1.
2.
 For i =  555  To  1  Step - 1 
If Mid(Cells(i,  8 ),  1 ,  5 ) = "TOTAL" Then Rows(i +  1 ).Insert
Next i

или так


Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
     i =  5 
         Do 
 If Left(Cells(i,  8 ),  5 ) = "TOTAL" Then
            Rows(CStr(i +  1 ) + ":" + CStr(i +  1 )).Select
        Selection.Insert shift:=xlDown
 End If
    
     i = i +  1 
Loop Until i = iRows


оно все работает вроде нормально, но в последних блоках данные вставляются из csv и их макро не форматирует
...
Рейтинг: 0 / 0
macros -- данные из csv файла надо вставить в Excel
    #36572817
sasha2345
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
так выглядит до вставки пустой строчки после TOTAL -- все нормально
...
Рейтинг: 0 / 0
macros -- данные из csv файла надо вставить в Excel
    #36572820
sasha2345
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
а так когда делаю вставку пустой строчки после TOTAL -- нет никакого формата в конце:
...
Рейтинг: 0 / 0
macros -- данные из csv файла надо вставить в Excel
    #36572831
sasha2345
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Код: 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.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
118.
119.
120.
121.
122.
123.
124.
125.
126.
127.
128.
129.
130.
131.
132.
133.
134.
135.
136.
137.
138.
139.
140.
141.
142.
143.
144.
145.
146.
147.
148.
149.
150.
151.
152.
153.
154.
155.
156.
157.
158.
159.
160.
161.
162.
163.
164.
165.
166.
167.
168.
169.
170.
171.
172.
173.
174.
175.
176.
177.
178.
179.
180.
181.
182.
183.
184.
185.
186.
187.
188.
189.
190.
191.
192.
193.
194.
195.
196.
197.
198.
199.
200.
201.
202.
203.
204.
205.
206.
207.
208.
209.
210.
211.
212.
213.
214.
215.
216.
217.
218.
219.
220.
221.
222.
223.
224.
225.
226.
227.
228.
229.
230.
231.
232.
233.
234.
235.
236.
237.
238.
239.
240.
241.
242.
243.
244.
245.
246.
247.
248.
249.
250.
251.
252.
253.
254.
255.
256.
257.
258.
259.
260.
261.
262.
263.
264.
265.
266.
267.
268.
269.
270.
271.
272.
273.
274.
275.
276.
277.
278.
279.
280.
281.
282.
283.
284.
285.
286.
287.
288.
289.
290.
291.
292.
293.
294.
295.
296.
297.
298.
299.
300.
301.
302.
303.
304.
305.
306.
307.
308.
309.
310.
311.
312.
313.
314.
315.
316.
317.
318.
319.
320.
321.
322.
323.
324.
325.
326.
327.
328.
329.
330.
331.
332.
333.
334.
335.
336.
337.
338.
339.
340.
341.
342.
343.
344.
345.
346.
347.
348.
349.
350.
351.
352.
353.
354.
355.
356.
357.
358.
359.
360.
361.
362.
363.
364.
365.
366.
367.
368.
369.
370.
371.
372.
373.
374.
375.
376.
377.
378.
379.
380.
381.
382.
383.
384.
385.
386.
387.
388.
389.
390.
391.
392.
393.
394.
395.
396.
397.
398.
399.
400.
401.
402.
403.
404.
405.
406.
407.
408.
409.
410.
411.
412.
413.
414.
 Sub testrrr()
Dim iRow%
Dim i%

 

iRows = ActiveCell.SpecialCells(xlLastCell).row
  
 
  Columns("M:M").Select
  Selection.Cut
  Columns("D:D").Select
  Selection.Insert Shift:=xlToRight

 
  For i =  1  To  6 
    If Left(Cells(i,  1 ),  4 ) = "ADD1" Then
      iLength = InStr(Cells(i,  1 ), "CSZ=")
      sAddr1 = Mid(Cells(i,  1 ),  7 , iLength -  7 )
      sCsz = Mid(Cells(i,  1 ), iLength +  5 )
      Rows(CStr(i) + ":" + CStr(i)).Select
        Selection.Delete Shift:=xlUp
      Exit For
    End If
  Next i
 
 
 
 
  Rows("1:2").Select
    Selection.Delete Shift:=xlUp
    
    
    
    
       Rows("2:2").Select
      Selection.Insert Shift:=xlDown
 

  
 
    Columns("A:A").Select
    Selection.Insert Shift:=xlToRight
    Columns("A:A").ColumnWidth =  1 . 14 
    Columns("N:N").ColumnWidth =  1 . 14 
    
        'Set Row Heighth
    Rows("1:2").RowHeight =  12 #
    
    
    
  For i =  555  To  1  Step - 1 
If Mid(Cells(i,  8 ),  1 ,  5 ) = "TOTAL" Then Rows(i +  1 ).Insert
  Next i
   
       
    
        '---------------------
 
  i =  5 
      Do
                   
    Set x = Columns( 8 ).Find(What:="TOTAL OTHER REVENUE", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
If x Is Nothing Then
    Set x = Columns( 8 ).Find(What:="OTHER REVENUE", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
        If Not x Is Nothing Then
        Rows(x.row).EntireRow.Delete
        End If
End If
          
     Set x1 = Columns( 8 ).Find(What:="TOTAL A&G PAYROLL", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
If x1 Is Nothing Then
    Set x1 = Columns( 8 ).Find(What:="A&G PAYROLL", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
        If Not x1 Is Nothing Then
        Rows(x1.row).EntireRow.Delete
        End If
End If
                  
    Set x2 = Columns( 8 ).Find(What:="TOTAL A&G OTHER", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
If x2 Is Nothing Then
    Set x2 = Columns( 8 ).Find(What:="A&G OTHER", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
        If Not x2 Is Nothing Then
        Rows(x2.row).EntireRow.Delete
        End If
End If

    Set x3 = Columns( 8 ).Find(What:="TOTAL MARKETING  PAYROLL", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
If x3 Is Nothing Then
    Set x3 = Columns( 8 ).Find(What:="MARKETING  PAYROLL", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
        If Not x3 Is Nothing Then
        Rows(x3.row).EntireRow.Delete
        End If
End If

    Set x4 = Columns( 8 ).Find(What:="TOTAL MARKETING & ADVERTISING", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
If x4 Is Nothing Then
    Set x4 = Columns( 8 ).Find(What:="MARKETING & ADVERTISING", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
        If Not x4 Is Nothing Then
        Rows(x4.row).EntireRow.Delete
        End If
End If

    Set x5 = Columns( 8 ).Find(What:="TOTAL UTILITIES", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
If x5 Is Nothing Then
    Set x5 = Columns( 8 ).Find(What:="UTILITIES", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
        If Not x5 Is Nothing Then
        Rows(x5.row).EntireRow.Delete
        End If
End If

    Set x6 = Columns( 8 ).Find(What:="TOTAL OPERATIONS PAYROLL", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
If x6 Is Nothing Then
    Set x6 = Columns( 8 ).Find(What:="OPERATIONS PAYROLL", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
        If Not x6 Is Nothing Then
        Rows(x6.row).EntireRow.Delete
        End If
End If

    Set x7 = Columns( 8 ).Find(What:="TOTAL MAINTENANCE PAYROLL", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
If x7 Is Nothing Then
    Set x7 = Columns( 8 ).Find(What:="MAINTENANCE PAYROLL", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
        If Not x7 Is Nothing Then
        Rows(x7.row).EntireRow.Delete
        End If
End If

    Set x8 = Columns( 8 ).Find(What:="TOTAL REPAIRS AND MAINTENANCE", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
If x8 Is Nothing Then
    Set x8 = Columns( 8 ).Find(What:="REPAIRS AND MAINTENANCE", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
        If Not x8 Is Nothing Then
        Rows(x8.row).EntireRow.Delete
        End If
End If

    Set x9 = Columns( 8 ).Find(What:="TOTAL CONTRACT MAINTENANCE", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
If x9 Is Nothing Then
    Set x9 = Columns( 8 ).Find(What:="CONTRACT MAINTENANCE", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
        If Not x9 Is Nothing Then
        Rows(x9.row).EntireRow.Delete
        End If
End If

    Set x10 = Columns( 8 ).Find(What:="TOTAL OTHER INCOME", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
If x10 Is Nothing Then
    Set x10 = Columns( 8 ).Find(What:="TENNANT FEES", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
        If Not x10 Is Nothing Then
        Rows(x10.row).EntireRow.Delete
        End If
End If

    Set x11 = Columns( 8 ).Find(What:="TOTAL TURNOVER COSTS", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
If x11 Is Nothing Then
    Set x11 = Columns( 8 ).Find(What:="TURNOVER COSTS", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
        If Not x11 Is Nothing Then
        Rows(x11.row).EntireRow.Delete
        End If
End If

    Set x12 = Columns( 8 ).Find(What:="TOTAL NRP EXPENSE", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
If x12 Is Nothing Then
    Set x12 = Columns( 8 ).Find(What:="NRP EXPENSE", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
        If Not x12 Is Nothing Then
        Rows(x12.row).EntireRow.Delete
        End If
End If

    Set x13 = Columns( 8 ).Find(What:="TOTAL OTHER DEDUCTIONS", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
If x13 Is Nothing Then
    Set x13 = Columns( 8 ).Find(What:="OTHER DEDUCTIONS", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
        If Not x13 Is Nothing Then
        Rows(x13.row).EntireRow.Delete
        End If
End If

  i = i +  1 
Loop Until i = iRows
 

 
    
    
    
 
 
  '-------------------------------------------------
   
i =  3 
Do
  
  
          If Left(Cells(i,  8 ),  5 ) = "TOTAL" Or _
             Left(Cells(i,  8 ),  22 ) = "GROSS OPERATING PROFIT" Then
             Range("B" & i & ":L" & i).Select
            
 
            
            
          With Selection.Interior  
            .ColorIndex =  19 
            .Pattern = xlSolid
          End With
            
           With Selection.Borders(xlEdgeTop)
               .LineStyle = xlContinuous      
               .Weight = xlThin
               .ColorIndex = xlAutomatic
           End With
           With Selection.Borders(xlEdgeBottom)
               .LineStyle = xlContinuous      
               .Weight = xlThin
               .ColorIndex = xlAutomatic
           End With
         End If
  
  '------------------------- added for 7 big groups
  
  
          If Left(Cells(i,  8 ),  21 ) = "TOTAL RESIDENTAL RENT" Or _
             Left(Cells(i,  8 ),  24 ) = "TOTAL OPERATING EXPENSES" Or _
             Left(Cells(i,  8 ),  16 ) = "TOTAL NET INCOME" Or _
             Left(Cells(i,  8 ),  16 ) = "TOTAL LABOR COST" Or _
             Left(Cells(i,  8 ),  32 ) = "TOTAL GARAGE DEPARTMENTAL PROFIT" Or _
             Left(Cells(i,  8 ),  30 ) = "TOTAL HEALTH CLUB DEPT. PROFIT" Or _
               Left(Cells(i,  8 ),  28 ) = "TOTAL GROSS OPERATION INCOME" Then
            Range("B" & i & ":L" & i).Select
            
            
            
            
      With Selection.Interior  
            .ColorIndex =  35 
            .Pattern = xlSolid
          End With
            
    With Selection.Font
        .Name = "Arial"
        .FontStyle = "Bold"
    End With
            
     End If
 
  
  '---------------------------------------  
   


          If Left(Cells(i,  8 ),  21 ) = "RESIDENTAL RENT" Or _
             Left(Cells(i,  8 ),  24 ) = "RENT REVENUE" Or _
             Left(Cells(i,  8 ),  16 ) = "OTHER REVENUE" Or _
             Left(Cells(i,  8 ),  16 ) = "TENNANT FEES" Or _
             Left(Cells(i,  8 ),  32 ) = "OPERATING EXPENSES" Or _
                Left(Cells(i,  8 ),  24 ) = "A&G PAYROLL" Or _
             Left(Cells(i,  8 ),  16 ) = "A&G OTHER" Or _
             Left(Cells(i,  8 ),  18 ) = "MARKETING  PAYROLL" Or _
             Left(Cells(i,  8 ),  32 ) = "MARKETING & ADVERTISING" Or _
             Left(Cells(i,  8 ),  30 ) = "UTILITIES" Or _
             Left(Cells(i,  8 ),  24 ) = "OPERATIONS PAYROLL" Or _
             Left(Cells(i,  8 ),  19 ) = "MAINTENANCE PAYROLL" Or _
             Left(Cells(i,  8 ),  23 ) = "REPAIRS AND MAINTENANCE" Or _
             Left(Cells(i,  8 ),  32 ) = "CONTRACT MAINTENANCE" Or _
             Left(Cells(i,  8 ),  30 ) = "TURNOVER COSTS" Or _
             Left(Cells(i,  8 ),  32 ) = "RENOVATION" Or _
             Left(Cells(i,  8 ),  30 ) = "NRP EXPENSE" Or _
             Left(Cells(i,  8 ),  30 ) = "OTHER DEDUCTIONS" Then
            Range("B" & i & ":L" & i).Select
            
 
            
    With Selection.Font
        .Name = "Arial"
        .FontStyle = "Bold"
    End With
            
     End If
  
 
  
  i = i +  1 
Loop Until i = iRows



 


  '-----------------------------------------  
 
   
  i =  6 
Do
     


     If Cells(i,  3 ) <  0  Or _
        Cells(i,  3 ) >  0  Then
        Cells(i,  3 ) = - 1  * Cells(i,  3 )
    End If

     If Cells(i,  4 ) <  0  Or _
        Cells(i,  4 ) >  0  Then
        Cells(i,  4 ) = - 1  * Cells(i,  4 )
    End If

     If Cells(i,  6 ) <  0  Or _
        Cells(i,  6 ) >  0  Then
        Cells(i,  6 ) = - 1  * Cells(i,  6 )
    End If


 


    
     If Cells(i,  11 ) <  0  Or _
        Cells(i,  11 ) >  0  Then
        Cells(i,  11 ) = - 1  * Cells(i,  11 )
    End If

    
 

  
     If Cells(i,  10 ) <  0  Or _
        Cells(i,  10 ) >  0  Then
        Cells(i,  10 ) = - 1  * Cells(i,  10 )
    End If
  
     If Cells(i,  9 ) <  0  Or _
        Cells(i,  9 ) >  0  Then
        Cells(i,  9 ) = - 1  * Cells(i,  9 )
    End If
  
  
  
  
  i = i +  1 
 
Loop Until Left(Cells(i,  8 ),  18 ) = "OPERATING EXPENSES"

   


 
 
   
   
   

 'delete extra rows
    Columns("B:B").Select
    Selection.Delete Shift:=xlToLeft
 
 Columns("D:D").Select
    Selection.Delete Shift:=xlToLeft
    
     Columns("B:B").Select
    Selection.Insert Shift:=xlToLeft
    
    
    
 
  'set data font size & row heighth
  Range("A1:N" & iRows +  4 ).Select
    Selection.Font.Size =  6 
  Rows("3:" & iRows).Select
    Selection.RowHeight =  10 . 5 


  Columns("B:B").ColumnWidth =  5   '12
  Columns("C:C").ColumnWidth =  10   '30
  'Columns("C:C").HorizontalAlignment = xlLeft
  Columns("D:M").ColumnWidth =  10 
  Columns("N:N").ColumnWidth =  10 

  Columns("D:F").ColumnWidth =  10   '12
  Columns("G:G").ColumnWidth =  25 
  Columns("G:G").HorizontalAlignment = xlCenter
  Columns("H:K").ColumnWidth =  10                      
        Columns("L:M").ColumnWidth =  4 
          'Format date cells in heading
  Range("I2:M2").Select
  Selection.NumberFormat = "mmm-yy"

  
        'Center and shade heading box
    Range("A1:N2").Select
    With Selection
        .HorizontalAlignment = xlCenter
    End With
    With Selection.Interior
        .ColorIndex =  36 
        .Pattern = xlSolid
    End With
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With

End Sub
...
Рейтинг: 0 / 0
macros -- данные из csv файла надо вставить в Excel
    #36572863
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
sasha2345,
Лучше бы файл с макросом (перед его выполнением) приложили бы, проще было анализировать.

Что заметил: цикл в операции Find-delete совершенно не нужен, так Вы 550(?) раз делаете ненужную работу - хватит и одного раза. Уже всё найдено и удалено. Но конечно если там удалять надо не по одной строке, тогда это работает, но тогда надо просто поиск организовать с продолжением, а не многократно делать одиночный поиск.
...
Рейтинг: 0 / 0
macros -- данные из csv файла надо вставить в Excel
    #36572872
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Так, опять те же грабли:
формат внизу не ставится потому, что iRows у Вас определяется в самом начале кода, и после вставки строк их количество естественно увеличивается, а iRows остаётся прежним. Поэтому нижние строки уже не проверяются в цикле
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
i =  3 
Do
... 
          If Left(Cells(i,  8 ),  5 ) = "TOTAL" Or _
             Left(Cells(i,  8 ),  22 ) = "GROSS OPERATING PROFIT" Then
             Range("B" & i & ":L" & i).Select
            
 
            
            
          With Selection.Interior
            .ColorIndex =  19 
            .Pattern = xlSolid
          End With
... 
  i = i +  1 
Loop Until i = iRows

Выход:
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
iRows = ActiveCell.SpecialCells(xlLastCell).Row

For i = iRowsTo  1  Step - 1  'зачем здесь было именно 555, если есть iRows?
If Mid(Cells(i,  8 ),  1 ,  5 ) = "TOTAL" Then Rows(i +  1 ).Insert
Next

iRows = ActiveCell.SpecialCells(xlLastCell).Row
i =  3 
Do
...

Но 100% за верность кода не ручаюсь - проверить не могу - нет файла...
...
Рейтинг: 0 / 0
macros -- данные из csv файла надо вставить в Excel
    #36572880
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Вот, сделал пример, работает до низу, поанализируй:
...
Рейтинг: 0 / 0
macros -- данные из csv файла надо вставить в Excel
    #36572890
sasha2345
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
...
Рейтинг: 0 / 0
macros -- данные из csv файла надо вставить в Excel
    #36572893
sasha2345
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
...
Рейтинг: 0 / 0
macros -- данные из csv файла надо вставить в Excel
    #36572897
sasha2345
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
поменял на i = iRows To... -- но все тоже самое
Я выложил тут макрос и csv файл


Hugo121, твой файл я скачал и он ранается, но я хотел посмотреть сам макрос но он не активен в Excel:

View--> Macros--->Edit
...
Рейтинг: 0 / 0
macros -- данные из csv файла надо вставить в Excel
    #36572906
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
sasha2345,
Вот это что делает?
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
  For i =  1  To  6 
    If Left(Cells(i,  1 ),  4 ) = "ADD1" Then
      iLength = InStr(Cells(i,  1 ), "CSZ=")
      sAddr1 = Mid(Cells(i,  1 ),  7 , iLength -  7 )
      sCsz = Mid(Cells(i,  1 ), iLength +  5 )
      Rows(CStr(i) + ":" + CStr(i)).Select
        Selection.Delete Shift:=xlUp
      Exit For
    End If
  Next i
Там нет CSZ= в строке с ADD1, и вообще ADD1 во второй колонке, т.е. наверное сперва надо удалить первую?
Да и For i = 1 To 6 хочется сделать For i = 1 To 8 (в двух местах), а то тут и там ниже ошибки при
Cells(i, 3) = -1 * Cells(i, 3) вылазят...
В общем, что-то не стыкуется, такой код явно нерабочий на этом файле.

А мой код в листе, у меня через Alt+F8 можно выбрать и редактировать или запускать.
...
Рейтинг: 0 / 0
macros -- данные из csv файла надо вставить в Excel
    #36572924
sasha2345
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
это адрес и он нужен
удаление первой колонки там есть

но даже если я эту часть убираю -- то таже проблема всеравно остается

Hugo121sasha2345,
Вот это что делает?
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
  For i =  1  To  6 
    If Left(Cells(i,  1 ),  4 ) = "ADD1" Then
      iLength = InStr(Cells(i,  1 ), "CSZ=")
      sAddr1 = Mid(Cells(i,  1 ),  7 , iLength -  7 )
      sCsz = Mid(Cells(i,  1 ), iLength +  5 )
      Rows(CStr(i) + ":" + CStr(i)).Select
        Selection.Delete Shift:=xlUp
      Exit For
    End If
  Next i
Там нет CSZ= в строке с ADD1, и вообще ADD1 во второй колонке, т.е. наверное сперва надо удалить первую?
Да и For i = 1 To 6 хочется сделать For i = 1 To 8 (в двух местах), а то тут и там ниже ошибки при
Cells(i, 3) = -1 * Cells(i, 3) вылазят...
В общем, что-то не стыкуется, такой код явно нерабочий на этом файле.

А мой код в листе, у меня через Alt+F8 можно выбрать и редактировать или запускать.
...
Рейтинг: 0 / 0
macros -- данные из csv файла надо вставить в Excel
    #36572952
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
sasha2345, я поздно заметил новый csv файл, да, там есть CSZ, а почему в первом небыло???
Ну ладно, целиком проверить не получилось, так там всё наворочено... почему-то молча всё окончилось, хотя результат не сохранился - нет у меня такого сетевого диска... непорядок, тоже надо пофиксить.

Ну так и есть, чтобы до конца форматировало, надо ещё раз переназначить iRows, вот так:
Код: plaintext
1.
2.
3.
4.
For i = iRows To  1  Step - 1 
If Mid(Cells(i,  8 ),  1 ,  5 ) = "TOTAL" Then Rows(i +  1 ).Insert
Next
iRows = ActiveCell.SpecialCells(xlLastCell).row

Ну и цикл убери, когда удаляешь, вот тут:
Код: plaintext
1.
2.
3.
4.
5.
'  i = 5
'      Do
'
    Set x = Columns( 8 ).Find(What:="TOTAL OTHER REVENUE", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
If x Is Nothing Then
...
Вроде всё. Хотя код конечно... все эти select и activate - пратически нигде не нужны.
например
Код: plaintext
1.
2.
    Columns("A:A").Select
    Selection.Insert Shift:=xlToRight
легко меняется на
Код: plaintext
1.
    Columns( 1 ).Insert Shift:=xlToRight
...
Рейтинг: 0 / 0
25 сообщений из 39, страница 1 из 2
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / macros -- данные из csv файла надо вставить в Excel
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


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