Редактирование таблицы

[1134]

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

Сжав волю в кулак и напрягая единственную извилину, я произвёл на свет следующее:


Public Sub Pereskok()

Dim stolbec As Integer

Dim Cell As Range

Dim stroki As Integer

stolbec = 0

a = 0

For stroki = 125 To 144
Cells(stroki, 1).Select
If Cells(stroki, 1) = "y" Then

For Each Cell In Range(Cells(stroki, 3), Cells(stroki, 13))

Cell.Select

If Cell.Value = "" And Cell.Offset(1, 0).Value <> "" Then

Do

stolbec = stolbec - 1

If Cell.Offset(0, stolbec).Value <> "" Then
Cell.Value = Cell.Offset(0, stolbec).Value

a = a + 1

End If

Loop Until a = 1

a = 0
stolbec = 0
End If

Next Cell

End If

Next stroki

End Sub




а затем ещё и вот это:




Public Sub u()
b = 0
For stroki = 120 To 142
Cells(stroki, 2).Select
If Cells(stroki, 2) = "" And Cells(stroki, 1) = "y" Then
Do
b = b - 1
Cells(stroki + b, 1).Select
If Cells(stroki + b, 1) = "y" And Cells(stroki + b, 2) <> "" Then
Cells(stroki + b, 13).Select
Cells(stroki, 2).Select
Cells(stroki, 2).Value = Cells(stroki + b, 13).Value
a = a + 1
End If
Loop Until a = 1
a = 0
b = 0
End If
Next stroki
End Sub





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

Заранее благодарен!

[Maxx]

Да! Я долго вдумчиво пялился в Ваши расчудесные таблички, но честно говоря, так и не понял логики построения таблички "Желаемый вид"

Может как-то по-подробнее!

[1134]

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

[Maxx]

Sub fillTable()

Dim i As Integer, j As Integer

For i = 1 To 14 ' перебор строк
    
   If Cells(i, 1) = "y" Then
        
        Cells(i, 1).Select
        For j = 2 To 11 ' перебор столбцов
            If Cells(i, j) = "" And Cells(i + 1, j) = "" Then Cells(i, j) = ""
            If Cells(i, j) <> 0 And Cells(i + 1, j) <> 0 Then lastFiiledValue = Cells(i, j)
            If Cells(i, j) = "" And Cells(i + 1, j) <> 0 Then Cells(i, j) = lastFiiledValue
        Next j
    Else:
        i = i
    End If
    
Next i

End Sub

[1134]

Благодарю!

[1134]

Я подумал над вашим предложением и теперь мой макрос выглядит примерно так, и вроде всё ничего, но никак не могу раскрыть тайну загадочной красной строчки, на которой всё спотыкаетя:

Sub ZAPOLNYALKA()

Application.ScreenUpdating = False

Application.Calculation = xlManual

Dim H As Integer

Dim Cell As Range

Dim stroki As Integer

Dim qqq As Integer

Dim sutki As Integer

Dim PosledniyList As Integer

PosledniyList = Worksheets.Count

a = 0

For qqq = 1 To PosledniyList

Sheets(qqq).Select

For stroki = 1 To 200

Select Case Cells(stroki, 1).Value

Case "ßíâàðü"

sutki = 36

Case "Ôåâðàëü"

sutki = 33

Case "Ìàðò"

sutki = 36

Case "Àïðåëü"

sutki = 35

Case "Ìàé"

sutki = 36

Case "Èþíü"

sutki = 35

Case "Èþëü"

sutki = 36

Case "Àâãóñò"

sutki = 36

Case "Ñåíòÿáðü"

sutki = 35

Case "Îêòÿáðü"

sutki = 36

Case "Íîÿáðü"

sutki = 35

Case "Äåêàáðü"

sytki = 36

End Select

If Cells(stroki, 4) = "Qæ,ì3/ñóò" Then

H = 0

Do

H = H + 1

If Cell(stroki + H, 4).Value = "Íä, ì" Then

a = a + 1

End If

Loop Until a = 1

a = 0

Cells(stroki, 1).Select

For j = 6 To sutki ' ïåðåáîð ñòîëáöîâ

If Cells(stroki, j) = "" And Cells(stroki + H, j) = "" Then Cells(stroki, j) = ""

If Cells(stroki, j) <> 0 And Cells(stroki + H, j) <> 0 Then lastFiiledValue = Cells(stroki, j)

If Cells(stroki, j) = "" And Cells(stroki + H, j) <> 0 Then Cells(stroki, j) = lastFiiledValue

Next j

Else:

stroki = stroki

End If

Next stroki

Next qqq

'Application.ScreenUpdating = True

'Application.Calculation = xlAutomatic

End Sub


Буду признателен за помощь!

[EducatedFool]

Замените If Cell(stroki + H, 4).Value =
на If Cells(stroki + H, 4).Value =

[1134]

Большое спасибо, буду внимательней!