» Excel VBA

The okk

Цитата:

Тем, что хороший код VBA должен максимально использовать возможности Excel

По мне, так лишь бы корректно работало. Хотя в твоём случае, подобный поиск может в последствии дань что-то новое. Извини, но я скорее ремесленник, ковырять особо нет желания. Я чаще чего-нибудь в VBA сделаю, чем, как описано в Excel FAQ, буду ломать голову, как обойтись формулами. Ладно, закругляюсь - это уже флуд с моей стороны.

AndVGri

Цитата:

Set pDest = Worksheets.Add
pos = 1& 'Вот здесь, например
For i = 4& To pSource.UsedRange.Rows.Count - 3& Step 4&

Спасибо, все ОК

Do Until w1.Worksheets(1).Cells(i, 3).Value = ""
i = i + 1

Do Until w2.Worksheets(1).Cells(j, 3).Value = "" Or w1.Worksheets(1).Cells(i, 3).Value = w2.Worksheets(1).Cells(j, 3).Value
j = j + 1
Loop

If w1.Worksheets(1).Cells(i, 3).Value = w2.Worksheets(1).Cells(j, 3).Value Then w1.Worksheets(1).Cells(i, 3).Color = RGB(128, 255, 128)

Loop

подскажите пожалуйста, как мне вложить цикл в цикл?

presnja
Не понял, а у вас что? Do в Do - где тут не вложение? Может вам перед внутренним Do сбрасывать j в начальное состояние нужно?

спасибо , заработало

SERGE_BLIZNUK
AndVGri
The okk
Снимаю шляпу

Ребята помогите почему в цикле For не меняєтся значение

Код:
ttribute VB_Name = "Module30"
Sub kulik_clear()

Sheets("КУЛ").Select
For i = 1 To 256
If Cells(21, i).Value = "slojka" Then slojka = i
Next i
Range(Cells(6, 5), Cells(6, slojka - 1)).ClearContents
For i = 1 To 256
If Cells(21, i).Value = "tisto" Then tisto = i
Next i
Range(Cells(6, slojka + 1), Cells(6, tisto - 1)).ClearContents
Range(Cells(6, tisto + 1), Cells(6, tisto + 5)).ClearContents
For i = 1 To 256
If Cells(21, i).Value = "slinz" Then slinz = i
Next i
Range(Cells(6, tisto + 6), Cells(6, slinz - 1)).ClearContents

End Sub
Sub analiz_vyrobn_rentab()
Attribute analiz_vyrobn_rentab.VB_Description = "Макрос записан 10.04.2007 (Dkorkuna)"
Attribute analiz_vyrobn_rentab.VB_ProcData.VB_Invoke_Func = " \n14"

Application.ScreenUpdating = False

Dim Month As String
'Dim data As Integer
For data = 105 To 134
For fnum = 1 To 31
'data = data + 1
Sheets("ВХ").Select
Month = "04"
If Len(fnum) = 1 Then t = "0" & CStr(fnum): GoTo 5 Else GoTo 10
10
t = CStr(fnum)
5

Cells(data, 2).FormulaR1C1 = _
"='\\hlibprom\fs\Documents\FAU\ANALYTICS\RENTABEL\2007\2007" & (Month) & "\Розсилка\[Рентабельність " & (t) & "_" & (Month) & "_07.xls]ХЗ'!R5C4"

Cells(data, 3).FormulaR1C1 = _
"='\\hlibprom\fs\Documents\FAU\ANALYTICS\RENTABEL\2007\2007" & (Month) & "\Розсилка\[Рентабельність " & (t) & "_" & (Month) & "_07.xls]ХЗ'!R34C4"
Cells(data, 4).FormulaR1C1 = _
"='\\hlibprom\fs\Documents\FAU\ANALYTICS\RENTABEL\2007\2007" & (Month) & "\Розсилка\[Рентабельність " & (t) & "_" & (Month) & "_07.xls]ХЗ'!R33C4"

Sheets("ЛХЗ №5").Select
Cells(data, 2).FormulaR1C1 = _
"='\\hlibprom\fs\Documents\FAU\ANALYTICS\RENTABEL\2007\2007" & (Month) & "\Розсилка\[Рентабельність " & (t) & "_" & (Month) & "_07.xls]ХЗ'!R5C5"
Cells(data, 3).FormulaR1C1 = _
"='\\hlibprom\fs\Documents\FAU\ANALYTICS\RENTABEL\2007\2007" & (Month) & "\Розсилка\[Рентабельність " & (t) & "_" & (Month) & "_07.xls]ХЗ'!R34C5"
Cells(data, 4).FormulaR1C1 = _
"='\\hlibprom\fs\Documents\FAU\ANALYTICS\RENTABEL\2007\2007" & (Month) & "\Розсилка\[Рентабельність " & (t) & "_" & (Month) & "_07.xls]ХЗ'!R33C5"

Sheets("ГХ").Select
Cells(data, 2).FormulaR1C1 = _
"='\\hlibprom\fs\Documents\FAU\ANALYTICS\RENTABEL\2007\2007" & (Month) & "\Розсилка\[Рентабельність " & (t) & "_" & (Month) & "_07.xls]ХЗ'!R5C7"
Cells(data, 3).FormulaR1C1 = _
"='\\hlibprom\fs\Documents\FAU\ANALYTICS\RENTABEL\2007\2007" & (Month) & "\Розсилка\[Рентабельність " & (t) & "_" & (Month) & "_07.xls]ХЗ'!R34C7"
Cells(data, 4).FormulaR1C1 = _
"='\\hlibprom\fs\Documents\FAU\ANALYTICS\RENTABEL\2007\2007" & (Month) & "\Розсилка\[Рентабельність " & (t) & "_" & (Month) & "_07.xls]ХЗ'!R33C7"

Sheets("БХ").Select

Cells(data, 2).FormulaR1C1 = _
"='\\hlibprom\fs\Documents\FAU\ANALYTICS\RENTABEL\2007\2007" & (Month) & "\Розсилка\[Рентабельність " & (t) & "_" & (Month) & "_07.xls]ХЗ'!R5C8"
Cells(data, 3).FormulaR1C1 = _
"='\\hlibprom\fs\Documents\FAU\ANALYTICS\RENTABEL\2007\2007" & (Month) & "\Розсилка\[Рентабельність " & (t) & "_" & (Month) & "_07.xls]ХЗ'!R34C8"
Cells(data, 4).FormulaR1C1 = _
"='\\hlibprom\fs\Documents\FAU\ANALYTICS\RENTABEL\2007\2007" & (Month) & "\Розсилка\[Рентабельність " & (t) & "_" & (Month) & "_07.xls]ХЗ'!R33C8"
Sheets("МП").Select
Cells(data, 2).FormulaR1C1 = _
"='\\hlibprom\fs\Documents\FAU\ANALYTICS\RENTABEL\2007\2007" & (Month) & "\Розсилка\[Рентабельність " & (t) & "_" & (Month) & "_07.xls]ХЗ'!R5C9"
Cells(data, 3).FormulaR1C1 = _
"='\\hlibprom\fs\Documents\FAU\ANALYTICS\RENTABEL\2007\2007" & (Month) & "\Розсилка\[Рентабельність " & (t) & "_" & (Month) & "_07.xls]ХЗ'!R34C9"
Cells(data, 4).FormulaR1C1 = _
"='\\hlibprom\fs\Documents\FAU\ANALYTICS\RENTABEL\2007\2007" & (Month) & "\Розсилка\[Рентабельність " & (t) & "_" & (Month) & "_07.xls]ХЗ'!R33C9"

Sheets("ЧГ").Select
Cells(data, 2).FormulaR1C1 = _
"='\\hlibprom\fs\Documents\FAU\ANALYTICS\RENTABEL\2007\2007" & (Month) & "\Розсилка\[Рентабельність " & (t) & "_" & (Month) & "_07.xls]ХЗ'!R5C10"
Cells(data, 3).FormulaR1C1 = _
"='\\hlibprom\fs\Documents\FAU\ANALYTICS\RENTABEL\2007\2007" & (Month) & "\Розсилка\[Рентабельність " & (t) & "_" & (Month) & "_07.xls]ХЗ'!R34C10"
Cells(data, 4).FormulaR1C1 = _
"='\\hlibprom\fs\Documents\FAU\ANALYTICS\RENTABEL\2007\2007" & (Month) & "\Розсилка\[Рентабельність " & (t) & "_" & (Month) & "_07.xls]ХЗ'!R33C10"

Sheets("КХ").Select
Cells(data, 2).FormulaR1C1 = _
"='\\hlibprom\fs\Documents\FAU\ANALYTICS\RENTABEL\2007\2007" & (Month) & "\Розсилка\[Рентабельність " & (t) & "_" & (Month) & "_07.xls]ХЗ'!R5C11"
Cells(data, 3).FormulaR1C1 = _
"='\\hlibprom\fs\Documents\FAU\ANALYTICS\RENTABEL\2007\2007" & (Month) & "\Розсилка\[Рентабельність " & (t) & "_" & (Month) & "_07.xls]ХЗ'!R34C11"
Cells(data, 4).FormulaR1C1 = _
"='\\hlibprom\fs\Documents\FAU\ANALYTICS\RENTABEL\2007\2007" & (Month) & "\Розсилка\[Рентабельність " & (t) & "_" & (Month) & "_07.xls]ХЗ'!R33C11"

Sheets("СХ").Select
Cells(data, 2).FormulaR1C1 = _
"='\\hlibprom\fs\Documents\FAU\ANALYTICS\RENTABEL\2007\2007" & (Month) & "\Розсилка\[Рентабельність " & (t) & "_" & (Month) & "_07.xls]ХЗ'!R5C12"
Cells(data, 3).FormulaR1C1 = _
"='\\hlibprom\fs\Documents\FAU\ANALYTICS\RENTABEL\2007\2007" & (Month) & "\Розсилка\[Рентабельність " & (t) & "_" & (Month) & "_07.xls]ХЗ'!R34C12"
Cells(data, 4).FormulaR1C1 = _
"='\\hlibprom\fs\Documents\FAU\ANALYTICS\RENTABEL\2007\2007" & (Month) & "\Розсилка\[Рентабельність " & (t) & "_" & (Month) & "_07.xls]ХЗ'!R33C12"

Sheets("РХ").Select
Cells(data, 2).FormulaR1C1 = _
"='\\hlibprom\fs\Documents\FAU\ANALYTICS\RENTABEL\2007\2007" & (Month) & "\Розсилка\[Рентабельність " & (t) & "_" & (Month) & "_07.xls]ХЗ'!R5C13"
Cells(data, 3).FormulaR1C1 = _
"='\\hlibprom\fs\Documents\FAU\ANALYTICS\RENTABEL\2007\2007" & (Month) & "\Розсилка\[Рентабельність " & (t) & "_" & (Month) & "_07.xls]ХЗ'!R34C13"
Cells(data, 4).FormulaR1C1 = _
"='\\hlibprom\fs\Documents\FAU\ANALYTICS\RENTABEL\2007\2007" & (Month) & "\Розсилка\[Рентабельність " & (t) & "_" & (Month) & "_07.xls]ХЗ'!R33C13"

Sheets("ЖШ").Select
Cells(data, 2).FormulaR1C1 = _
"='\\hlibprom\fs\Documents\FAU\ANALYTICS\RENTABEL\2007\2007" & (Month) & "\Розсилка\[Рентабельність " & (t) & "_" & (Month) & "_07.xls]ХЗ'!R5C14"
Cells(data, 3).FormulaR1C1 = _
"='\\hlibprom\fs\Documents\FAU\ANALYTICS\RENTABEL\2007\2007" & (Month) & "\Розсилка\[Рентабельність " & (t) & "_" & (Month) & "_07.xls]ХЗ'!R34C14"
Cells(data, 4).FormulaR1C1 = _
"='\\hlibprom\fs\Documents\FAU\ANALYTICS\RENTABEL\2007\2007" & (Month) & "\Розсилка\[Рентабельність " & (t) & "_" & (Month) & "_07.xls]ХЗ'!R33C14"

Sheets("КМХ").Select
Cells(data, 2).FormulaR1C1 = _
"='\\hlibprom\fs\Documents\FAU\ANALYTICS\RENTABEL\2007\2007" & (Month) & "\Розсилка\[Рентабельність " & (t) & "_" & (Month) & "_07.xls]ХЗ'!R5C15"
Cells(data, 3).FormulaR1C1 = _
"='\\hlibprom\fs\Documents\FAU\ANALYTICS\RENTABEL\2007\2007" & (Month) & "\Розсилка\[Рентабельність " & (t) & "_" & (Month) & "_07.xls]ХЗ'!R34C15"
Cells(data, 4).FormulaR1C1 = _
"='\\hlibprom\fs\Documents\FAU\ANALYTICS\RENTABEL\2007\2007" & (Month) & "\Розсилка\[Рентабельність " & (t) & "_" & (Month) & "_07.xls]ХЗ'!R33C15"

Sheets("ШП").Select
Cells(data, 2).FormulaR1C1 = _
"='\\hlibprom\fs\Documents\FAU\ANALYTICS\RENTABEL\2007\2007" & (Month) & "\Розсилка\[Рентабельність " & (t) & "_" & (Month) & "_07.xls]ХЗ'!R5C16"
Cells(data, 3).FormulaR1C1 = _
"='\\hlibprom\fs\Documents\FAU\ANALYTICS\RENTABEL\2007\2007" & (Month) & "\Розсилка\[Рентабельність " & (t) & "_" & (Month) & "_07.xls]ХЗ'!R34C16"
Cells(data, 4).FormulaR1C1 = _
"='\\hlibprom\fs\Documents\FAU\ANALYTICS\RENTABEL\2007\2007" & (Month) & "\Розсилка\[Рентабельність " & (t) & "_" & (Month) & "_07.xls]ХЗ'!R33C16"
' If fnum = 17 Then Exit Sub
Next fnum: Next data
End Sub

hackman
А вот это:
Цитата:

;îçñèëê&agrave

- часть твоей формулы, или просто трансформировалось при выкладывании на форум?
Может, выложишь файл куда-нибудь?
Носом чую, что тут 75% кода можно просто выкинуть ибо написан через запись макроса.

;îçñèëê&agrave - это юникоды так преобразуются при пересылке в через http
сорри за offtop

hackman
Значение в цикле for меняется. Вот к циклу как раз претензий нет... кроме самого факта его существования.
А проблема скорее всего в абсолютной адресации. R1C1 - это первая ячейка первого столбца, а R[1]C[1] - это ячейка со смещением в 1 столбец и 1 строку. У тебя у всех ячеек адресация абсолютная. Т.е. во все ячейки будет помещен одинаковый результат (впрочем, по этим иероглифам судить довольно сложно).

AndVGri
Большое спасибо, все работает. Просто я с html еще не работала, зато теперь научилась. еще раз спасибо.

http://forum.ru-board.com/topic.cgi?forum=33&topic=3961&start=2000#18

Виложил просто ето почему то плохо скопировалося из VBA редактора.
значения data не меняєтся в цикле For а менять все формули и вручну прописовать не хочу.

hackman
А какое значение не меняется? Если data, то во внутреннем цикле по fnum стоит выход

Цитата:

If fnum = 17 Then Exit Sub

так что data принимает только одно значение 105, а значения fnum изменяются от 1 до 16

AndVGri
Но там стоить коментарий. ето я сделал потому что сделано только 17 файлов

hackman
За комментарий прошу прощения, проглядел. Так, всё таки какое значение в цикле не меняется? Что получается в ячейках - не ошибка? Пожалуйста, по подробнее
Да, и такую конструкцию

Цитата:

If Len(fnum) = 1 Then t = "0" & CStr(fnum): GoTo 5 Else GoTo 10
10
t = CStr(fnum)
5

замените на t = Format$(fnum, "00")

Вот статья по созданию меню. Там не сказано где писать обработчик событий для пункта меню.
Всё разобрался ответ тут.
Как на английском будет меню Cервис->Макрос ?

Может кто подскажет, что сдесь лишнее?

Sub Конвертировать()
'
Application.ScreenUpdating = False
ActiveWindow.TabRatio = 0.335
Sheets("TDSheet").Name = "Ведомость"
Sheets.Add
Sheets("Лист1").Move After:=Sheets(2)
Sheets("Лист1").Name = "Остаток"
Worksheets("Остаток").Range("A1").Value = "Наименование"
Worksheets("Остаток").Range("B1").Value = "Номенклатурный номер"
Worksheets("Остаток").Range("C1").Value = "Остаток кол-во"
Worksheets("Остаток").Range("D1").Value = "Остаток цена"
Worksheets("Остаток").Range("E1").Value = "Приход количество"
Worksheets("Остаток").Range("F1").Value = "Приход цена"
Sheets.Add
Sheets("Ведомость").Select
ActiveWindow.DisplayOutline = False
Rows("1:11").Select
Selection.Delete Shift:=xlUp
Range("A:A,D:D,F:F,G:G,H:H").Select
Range("G1").Activate
Selection.Delete Shift:=xlToLeft
Range("A1").Select

Dim r As Long, LastRow As Long
LastRow = Worksheets("Ведомость").Range("A65536").End(xlUp).Row
For r = 1 To LastRow
If Cells(r, 1).Font.Bold = True Then
Rows(r + 1).Delete Shift:=xlUp
End If
If Cells(r, 1).Font.Bold = True Then
Rows(r).Delete Shift:=xlUp
End If
Next r
Dim pSource As Worksheet, pCell As Range
Dim pDest As Worksheet
Dim i As Long, pos As Long

Set pSource = ActiveSheet
Set pDest = Worksheets("Остаток")
pos = 1&
For i = 1& To pSource.UsedRange.Rows.Count - 3& Step 4&
pos = pos + 1&
Set pCell = pSource.Cells(i, 1&)
pDest.Cells(pos, 1&).Value = pCell.Value
pDest.Cells(pos, 2&).Value = pCell.Offset(2&, 0&).Value
pDest.Cells(pos, 3&).Value = pCell.Offset(1&, 1&).Value
pDest.Cells(pos, 4&).Value = pCell.Offset(0&, 1&).Value
pDest.Cells(pos, 5&).Value = pCell.Offset(1&, 2&).Value
pDest.Cells(pos, 6&).Value = pCell.Offset(0&, 2&).Value
pDest.Cells(pos, 7&).Value = pCell.Offset(1&, 3&).Value
pDest.Cells(pos, 8&).Value = pCell.Offset(0&, 3&).Value
Next i
Worksheets("Остаток").Activate
Columns("A:A").ColumnWidth = 40
Columns("B:B").ColumnWidth = 15.83
Columns("C:C").ColumnWidth = 11
Columns("D:D").ColumnWidth = 11
Columns("E:E").ColumnWidth = 11
Columns("F:F").ColumnWidth = 11
Columns("B:B").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
End With
Columns("C:C").Select
Selection.NumberFormat = "#,##0.000"
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlBottom
.WrapText = False
End With
Columns("D:D").Select
Selection.NumberFormat = "#,##0.00"
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlBottom
End With
Columns("E:E").Select
Selection.NumberFormat = "0.000"
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlBottom
End With
Columns("F:F").Select
Selection.NumberFormat = "#,##0.00"
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlBottom
.WrapText = False
End With
Rows("1:1").RowHeight = 29.25
Range("A1:F1").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
End With
Dim FinalRow As Long
FinalRow = Worksheets("Остаток").Range("D65536").End(xlUp).Row + 1
Cells(FinalRow, 4).FormulaR1C1 = "=SUM(R2C4:R[-1]C)"
Cells(FinalRow, 6).FormulaR1C1 = "=SUM(R2C6:R[-2]C)"
Cells(FinalRow, 4).Font.Bold = True
Cells(FinalRow, 6).Font.Bold = True

Range("A1").Select
End Sub

aks_sv
Ну, вот где-то так, может быть, должно упроститься, хотя, если что, то можно улучшить
[more]
Вы ображаетесь ниже к Worksheets("Остаток") и "Ведомость" (до того "TDSheet")
Тогда можно код записать так

Код:
Sheets("TDSheet").Name = "Ведомость"
Sheets.Add
Sheets("Лист1").Move After:=Sheets(2)
Sheets("Лист1").Name = "Остаток"
...
Dim pSource As Worksheet, pDest As Worksheet

AndVGri

Код значительно упростился, спасибо!