Затем подсчитывайте ячейки в новых строках ниже

Eric Fletcher спросил: 12 мая 2018 в 03:46 в: excel

Довольно новый. Нужна помощь!

У меня есть 61 отдельный лист в одной книге. Строка 8 на каждом листе имеет один и тот же тип данных, но меняется в зависимости от длины столбца от листа к листу (слева направо).

Я бы хотел написать скрипт VBA, который будет делать следующее :

  1. Начать в столбце A, строка 8.
  2. Подсчитать количество ячеек с данными в строке 8 (слева направо).
  3. Вставить строки ниже в зависимости от количества подсчитанных ячеек.
  4. Транспортируйте данные из строки 8 во вновь вставленные строки непосредственно ниже. В идеале я хотел бы сохранить первую часть данных (столбец A, строка 8), где она находится, и вставить остальные ниже.

У меня есть код написанный, но просто не может показаться, что оно завершено.

    Sub Macro3()
Dim example As Range
Set example = Range("A1")example.Rows(8).SelectusedRangeLastColNum = ActiveSheet.UsedRange.Columns.Count
MsgBox usedRangeLastColNumexample.EntireRow(9).Insert    End Sub

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

Я думаю, что я получил довольно далеко, основываясь на том, что я совершенно новичок в этом.

так много!

E

3 ответа

Есть решение
JvdV ответил: 12 мая 2018 в 04:44

Может быть, это хорошо? Должен делать то, что вы хотите

EDITED

Sub LoopSheets()Dim WS As Worksheet
Dim CL As Long, X As LongFor Each WS In ThisWorkbook.Sheets
    CL = WS.Cells(8, Columns.Count).End(xlToLeft).Column
    If CL > 1 Then
        WS.Cells(9, 1).EntireRow.Resize(CL - 1).Insert Shift:=xlDown
        For X = 2 To CL
            WS.Cells(7 + X, 1) = WS.Cells(8, X)
            WS.Cells(8, X).ClearContents
        Next X
    End If
Next WSEnd Sub
Eric Fletcher ответил: 12 мая 2018 в 04:09
Спасибо! Он сделал именно то, что я искал. Мое описание не совсем точно на моем конце. Я бы хотел, чтобы данные из Row 8 (минус данные из столбца A) были удалены после транспонирования. Кроме того, включенные ячейки ниже должны быть целыми рядами, так что остальная часть таблицы не будет скомпрометирована только из одного столбца за толкаемым вниз. ДРУГОЕ, ЧТО ЭТО СОВЕРШЕННО !!!!
JvdV ответил: 12 мая 2018 в 04:12
Ваш приветственный ответ теперь редактируется. Последний вопрос ("скомпрометирован только из одного столбца за толкаемым"). Я не совсем понимаю.
BigBen ответил: 12 мая 2018 в 04:28
@JvdV вы переписываете значения в "A9" вниз, так как вы не вставили строки заранее.
JvdV ответил: 12 мая 2018 в 04:32
Спасибо, теперь я понимаю, что имел в виду Эрик. Будет отредактировать код соответствующим образом. Спасибо @BigBen
Eric Fletcher ответил: 12 мая 2018 в 04:47
Это оно. Именно то, что я искал. Спасибо вам, что вы оба. Хотелось бы, чтобы у меня было достаточно Кармы, чтобы продвинуть это решение. На данный момент я отметил, что он решил.
urdearboy ответил: 12 мая 2018 в 04:32

Это приведет к транспонированию ваших значений в строке 8 (начиная с ячейки A9) и сдвинет все данные ниже. (Сдвиг вниз будет равен длине вашего диапазона в строке 8)

Вы также должны отключить отображение экрана при запуске цикла

Sub Transpose()Dim WS As Worksheet
Dim LCol As Long
Dim CopyRange As RangeApplication.ScreenUpdating = FalseFor Each WS In Worksheets
    LCol = WS.Cells(8, WS.Columns.Count).End(xlToLeft).Column 'Determine Last Column
    WS.Range("A9").EntireRow.Resize(LCol).Insert Shift:=xlDown 'Insert new cells to accommodate space for transpose
    Set CopyRange = Range(Cells(8, 1), Cells(8, LCol)) 'dynamic copy range
    CopyRange.Copy
    WS.Range("A9").PasteSpecial xlPasteValues, xlPasteSpecialOperationNone, , True
‘Add line to delete row 8 here
Next WSApplication.ScreenUpdating = FalseEnd Sub
JvdV ответил: 12 мая 2018 в 04:11
Хотя это способ сделать это (всегда полезно иметь несколько способов сделать что-то), это A: путь медленнее, а B: также копирует значение первого столбца.
BigBen ответил: 12 мая 2018 в 04:30
@urdearboy Я думаю, что вы вставляете 1 слишком много строк с помощью WS.Range("A9").EntireRow.Resize(LCol).Insert Shift:=xlDown.
Eric Fletcher ответил: 12 мая 2018 в 04:33
Что-то странное происходит. Для первого рабочего листа данные, которые были транспонированы, точно соответствуют данным, первоначально найденным в ROW. Однако, когда я перехожу на другой рабочий лист, транспонированные данные неверны. Это не точная копия данных строк, найденных на конкретном листе. Кажется, что это объединение данных / данных за пределами конкретного рабочего листа. Weird!
urdearboy ответил: 12 мая 2018 в 04:33
Обновлено - было прекрасно, прежде чем я попытался приспособиться к другому комментарию. Поскольку OP хочет удалить строку 8, мне все равно, копируя первую ячейку. Вернулся назад к моему первоначальному ответу ~
vbalearner ответил: 12 мая 2018 в 07:04

Диапазон от A2 до A8 - это наш массив, который мы собираемся перенести в диапазон от D2 до J2.

       A    B    C    D    E    F    G    H    I    J
1
2      1              1    2    3    4    5    6    7
3      2
4      3
5      4
6      5
7      6
8      7

Вот код:

Sub transpose()
 Dim r() As Long 'Array where values are going to be stored
 Dim i as integer 'Row number For i = 2 To 8
  'add the values of an array
   ReDim Preserve r(0 to 6)
   r(i-2) = CellS(i,1)   'Transpose the values of that array
   Cells(2,i+2) = r(i-2)
 Next i
End Sub