VBA: слишком много места осталось при копировании строк и транспонировании в столбцы - PullRequest
0 голосов
/ 07 августа 2020

Я написал код VBA (ниже) для:

  1. выбрать и скопировать строки с одного листа, которые соответствуют критерию
  2. вставить эти строки на другой лист, но транспонировать в столбцы, например, скопируйте диапазон A1: E1 в лист 1 и вставьте как A1: A5 в лист 2, затем скопируйте A2: E2 в лист 1 и вставьте как B1: B5 в лист 2

Код (почти !) делает то, что должен: выбирает строку, вместо этого копирует ее как столбец, НО оставляет десятки (если не больше) пустых столбцов между каждым скопированным битом.

Я попытался понять, почему это не так вставка строк в виде столбцов один за другим без пробелов, но я не очень хорошо разбираюсь в VBA, поэтому я борюсь. Что мне изменить? Любая помощь будет принята с благодарностью, спасибо!

A = Worksheets("TO BE").Range("A" & Rows.Count).End(xlUp).Row

For i = 2 To A

    If Worksheets("TO BE").Range("D" & i).Value = "7" Then
    
    Worksheets("TO BE").Range("A" & i & ":E" & i).Copy
    
    Worksheets("GRADE 7 MATRIX").Activate
    
    b = Worksheets("GRADE 7 MATRIX").Cells(1, Columns.Count).End(xlToLeft).Column
    
    Worksheets("GRADE 7 MATRIX").Cells(1 & b + 1).Select
    
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:= _
        True, Transpose:=True
    
    End If

Next

Application.CutCopyMode = False

1 Ответ

1 голос
/ 07 августа 2020

Cells(1 & b + 1) должно быть Cells(1, b + 1), вам нужно указать строку и столбец. Я полагаю, вы хотите вставить в первый пустой столбец первой строки ... В противном случае ваш код вернется в столбец Cell, полученный путем конкатенации 1 с b + 1. Если b будет 8, столбец будет 18. Для 20 => 120 и так далее. Только случается, что он вставляется в первую строку, не «сообщая» это вашим кодом ... Он достигнет второй строки только после 16384 (общее количество столбцов).

Тогда вы не должны выбрать / активировать что угодно. Ваш код (работает быстрее и стабильнее) при условии True должен быть:

Worksheets("TO BE").Range("A" & i & ":E" & i).Copy
    b = Worksheets("GRADE 7 MATRIX").Cells(1, Columns.Count).End(xlToLeft).Column   
    Worksheets("GRADE 7 MATRIX").Cells(1, b + 1).PasteSpecial _
           Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:= _
                                            True, Transpose:=True
...