VBA - только для циклов, печатающих последний элемент - PullRequest
0 голосов
/ 07 декабря 2018

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

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

Он работает для первого числа в новом листе, но когда он достигает строки ElseIf y > 11, он печатает только последнее число в массиве.

Sub ColumnToRow()

    Dim x As Integer
    Dim y As Integer
    Dim z As Integer
    Dim sht As Worksheet
    Dim myarray() as Variant

    Application.ScreenUpdating = False

    ReDim myarray(11 To 30)
    For x = 11 To 30
        myarray(x) = ActiveSheet.Cells(x, 1).Value
        y = x - 10
    Next x

    For y = 1 To 20
        If y = 11 Then
            z = 1

            Worksheets("0049-0050").Copy After:=Worksheets("0049-0050")
            Set sht = ActiveSheet
            sht.Range(Cells(50, z), Cells(40, y - 1)).ClearContents
            sht.Cells(50, z).Value = myarray(y + 10)

            z  = z + 1 'Typist's note:  so, "z = 2"?
        ElseIf y > 11 Then
            For z = 2 To 10
                sht.Cells(50, z).Value = myarray(y + 10)
            Next z
        Else
            Sheets("0049-0050").Cells(50, y).Value = myarray(y + 10)
        End If
    Next y

    Application.ScreenUpdating = True

End Sub

код

1 Ответ

0 голосов
/ 07 декабря 2018

@ BruceWayne Я выяснил, в чем заключается моя проблема, я пытался запустить цикл for в операторе ElseIf, что заставило его завершить этот вложенный цикл без выполнения внешнего цикла, поэтому я просто сделал приращение цикла с использованием целого числавместо этого:

Sub ColumnToRow()

Dim X As Integer
Dim y As Integer
Dim z As Integer
Dim sht As Worksheet
Dim myarray() As Variant


Application.ScreenUpdating = False

    ReDim myarray(11 To 30)
    For X = 11 To 30
        myarray(X) = ActiveSheet.Cells(X, 1).Value
        y = X - 10
    Next X


    For y = 1 To 20
        If y = 11 Then
         z = 1
            Worksheets("0049-0050").Copy After:=Worksheets("0049-0050")
            Set sht = ActiveSheet
            sht.Range(sht.Cells(50, z), sht.Cells(50, y - 1)).ClearContents
            sht.Cells(50, z).Value = myarray(y + 10)

        ElseIf y > 11 Then

            sht.Cells(50, z).Value = myarray(y + 10)

        Else
            Sheets("0049-0050").Cells(50, y).Value = myarray(y + 10)
        End If
            z = z + 1
    Next y

Application.ScreenUpdating = True

End Sub

  • Спасибо
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...