как заполнить другую часть таблицы

Question

У меня есть ячейки A1 19,200, B1 13/05/2020 и ячейки C1 72. Когда я выполняю VBA, таблица создается в Word, как показано ниже, и продолжается до 72

Instal No   Amt(Rs) Due Date    Instal No   Amt(Rs) Due Date
1   19200   13/05/2020          
2   19200   13/06/2020          
3   19200   13/07/2020          
4   19200   13/08/2020          
5   19200   13/09/2020          
6   19200   13/10/2020          
7   19200   13/11/2020          
8   19200   13/12/2020          
9   19200   13/01/2021          
10  19200   13/02/2021          
11  19200   13/03/2021          
12  19200   13/04/2021          
13  19200   13/05/2021          
14  19200   13/06/2021          
15  19200   13/07/2021          
16  19200   13/08/2021          

Пожалуйста обратите внимание, что C1 - это количество месяцев (т.е. номер установки).

Я хочу заполнить другую часть справа от поля таблицы. Позвольте мне уточнить, если C1 = 72 месяцев, затем разделите его на половину, что отправит 36 месяцев на другую сторону таблицы. Мое количество месяцев - четные числа (24,36,48,60,98)

Вы заметите, что я добавил 1 в "lngRows = Range (" C1 "). Value + 1" из-за заголовков

мои коды следующие: -

Sub CreateTableInWord()
Dim objWord As Object
Dim objDoc As Object
Dim objTbl As Object
Dim objRow As Object
Dim objCol As Object
Dim lngCols As Long
Dim lngRows As Long
Dim I As Long

    lngCols = 6
    lngRows = 72

    Set objWord = CreateObject("Word.Application")

    objWord.Visible = True

    Set objDoc = objWord.Documents.Add(DocumentType:=0)

    Set objTbl = objDoc.Tables.Add(Range:=objDoc.Paragraphs(1).Range, NumRows:=lngRows, NumColumns:=lngCols)

    Set objRow = objTbl.Rows(1)


   objTbl.Cell(1, 1).Range.Text = "Instal No"
   objTbl.Cell(1, 1).Range.Bold = True
   objTbl.Cell(1, 2).Range.Text = "Amt(Rs)"
   objTbl.Cell(1, 2).Range.Bold = True
   objTbl.Cell(1, 3).Range.Text = "Due Date"
   objTbl.Cell(2, 3) = Range("B1").Value
   objTbl.Cell(1, 3).Range.Bold = True
   objTbl.Cell(1, 4).Range.Text = "Instal No"
   objTbl.Cell(1, 4).Range.Bold = True
   objTbl.Cell(1, 5).Range.Text = "Amt(Rs)"
   objTbl.Cell(1, 5).Range.Bold = True
   objTbl.Cell(1, 6).Range.Text = "Due Date"
   objTbl.Cell(1, 6).Range.Bold = True
   objTbl.Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
    For I = 2 To lngRows

    ' For j = 1 To intNoOfColumns

  objTbl.Cell(I, 1).Range = I - 1

     Next

   For S = 2 To lngRows

  objTbl.Cell(S, 2) = Range("A1").Value

    Next

For T = 2 To lngRows

objTbl.Cell(T, 3).Range.Text = Format(DateAdd("m", T - 2, Range("B1").Value), "dd/mm/yyyy")
Next T




    Set objCol = Nothing

    Set objRow = Nothing

    Set objDoc = Nothing

    Set objWord = Nothing

End Sub

Answer 1

Попробуйте это:

Sub CreateTableInWord()

    Dim objWord As Object, objDoc As Object, objTbl As Object, objRow As Object
    Dim objCol As Object, colSets As Long, numMonths As Long, i As Long, n As Long, c As Long
    Dim amt, dtStart, tblRows As Long, tblCols As Long, rw As Long, col As Long

    numMonths = Range("A1").Value
    amt = Range("B1").Value
    dtStart = Range("C1").Value
    colSets = Range("D1").Value 'how many sets of columns ?

    tblRows = 1 + Application.Ceiling(numMonths / colSets, 1) 'how many table rows?
    tblCols = colSets * 3                                     'how many table cols?

    Set objWord = CreateObject("Word.Application")
    objWord.Visible = True
    Set objDoc = objWord.Documents.Add(DocumentType:=0)
    Set objTbl = objDoc.Tables.Add(Range:=objDoc.Paragraphs(1).Range, _
                 NumRows:=tblRows, NumColumns:=tblCols)

    c = 0
    For n = 1 To colSets
        objTbl.Cell(1, c + 1).Range.Text = "Instal No"
        objTbl.Cell(1, c + 1).Range.Bold = True
        objTbl.Cell(1, c + 2).Range.Text = "Amt(Rs)"
        objTbl.Cell(1, c + 2).Range.Bold = True
        objTbl.Cell(1, c + 3).Range.Text = "Due Date"
        objTbl.Cell(1, c + 3).Range.Bold = True
        c = c + 3
    Next n
    objTbl.Range.ParagraphFormat.Alignment = 1 ' wdAlignParagraphCenter

    rw = 2
    col = 0
    For i = 1 To numMonths

        'rw = 1 + Application.Ceiling(i / colSets, 1)  'fill across and then down
        rw = IIf(i Mod (tblRows - 1) = 1, 2, rw + 1)   'fill down then across

        objTbl.Cell(rw, col + 1).Range.Text = i
        objTbl.Cell(rw, col + 2).Range.Text = amt
        objTbl.Cell(rw, col + 3).Range.Text = DateAdd("m", i - 1, dtStart)

        'col = IIf(i Mod colSets = 0, 0, col + 3)         'fill across and then down
        col = IIf(i Mod (tblRows - 1) = 0, col + 3, col) 'fill down and then across

    Next i

End Sub