Как вставить пустые столбцы на основе определенных условий?

Question

Я хотел вставить определенное количество пустых столбцов. Например, столбец 1 строки 1 - это Q1, а столбец строки 1 - это Q2, поэтому мне не нужно вставлять пустой столбец.

Если в столбце 4 строки 1 указано Q5, столбец 3 строки 1 - Q3, поэтомуя хочу вставить (5-3-1) 1 пустую колонку, колонку для Q4

Изображение таблицы прилагается ниже.

https://imgur.com/NSatL9w

Извините, я впервые пишу на VBA. Любая помощь приветствуется.

Обновлено Ниже отображается сообщение об ошибке.

Ошибка компиляции: ожидаемый массив

Option Explicit

Sub Test()

Dim lCol As Integer
Dim pos() As Long
Dim pos1() As Long
Dim strString() As String

lCol = Cells(1, Columns.Count).End(xlToLeft).Column
For i = 1 To lCol
     If Left(Sheets(1).Cells(1, i).Value, 1) = "Q" Then
            pos(i) = InStr(1, Cells(1,i), "Q") + 1
            pos1(i) = InStr(pos(i), Cells(1,i), "<")
            strString(i) = Mid(Cells(1,i), pos(i), pos1(i) - pos(i))
            If strString(i + 1) - strString(i) > 1 Then
                Columns(strString(i)+1:strString(i+1)-1).Insert 
                Shift:=xlToRight
            End If
        End If
Next i

End Sub

Answer 1

Для конкретной ошибки переменные pos, pos1 и strString должны быть объявлены как массивы, поскольку мы храним несколько значений, а не только одно. Это можно сделать несколькими способами способами :

'Method 1 : Using Dim
Dim arr1()  'Without Size

'Method 2 : Mentioning the Size
Dim arr2(5)  'Declared with size of 5

'Method 3 : using 'Array' Parameter
Dim arr3
arr3 = Array("apple","Orange","Grapes")

Я буду использовать Method 1, и после того, как я узнаю, сколько столбцов нам нужно, я изменю размер / определю массив так, чтобы онбудет выглядеть так: Method 2.

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

Поскольку вы добавите столбцы,ваш «общий» диапазон будет изменяться для каждого вставленного столбца. Так что если у вас есть 14 столбцов с самого начала, вы можете пропустить последние, так как ваш диапазон увеличится. Поэтому я рекомендую начинать с правого и левого цикла.

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

Надеемся, что этот код поможет вам в этом:

Option Explicit

Sub test()

Dim lCol As Integer
Dim pos() 'Dim the variable as Array
Dim pos1() 'Dim the variable as Array
Dim strString() 'Dim the variable as Array
Dim i As Long 'Dim the variable i which will hold the position
Dim j As Long 'Dim the variable j which will loop for new inserted headers
Dim k As Long 'Dim the dummy variable k which will add one number for each empty header, between two quarters

    lCol = Cells(1, Columns.Count).End(xlToLeft).Column 'Find the last column to loop through
    ReDim pos(0 To lCol) 'When we know how many columns to loop through we can resize our array for the variable pos
    ReDim pos1(0 To lCol) 'Same logic as above
    ReDim strString(0 To lCol) 'Same logic as above

    For i = lCol + 1 To 1 Step -1 'Since we want to insert a new column our "complete range will change". Therefore we start backwards and to Column A
        If Left(Sheets(1).Cells(1, i).Value, 1) = "Q" Then 'Check if cell in row 1 starts with letter Q
            pos(i) = InStr(1, Cells(1, i), "Q") + 1 'Get position for Q and add 1
            pos1(i) = InStr(pos(i), Cells(1, i), "<") 'Get position for sign "<"
            strString(i) = Mid(Cells(1, i), pos(i), pos1(i) - pos(i)) 'Extract the difference between "pos" and "pos1" to get which quarter we are dealing with
            If ((strString(i + 1)) - strString(i)) > 1 And Not IsEmpty(strString(i + 1)) Then 'If the difference between cell "i +1" - cell "i" is larger than 1, and cell "i+1" is not empty, then..
                Columns(i + 1).Resize(, ((strString(i + 1)) - strString(i)) - 1).Insert '... We use the difference between the cells and then resize our range which we want to insert

                '### this part is only to create the header automatically, can be removed. ###
                If ((strString(i + 1)) - strString(i)) > 2 Then 'If the difference is larger than 2, it means that we need to insert at least 2 columns or more
                    k = 1 'Set dummy variable k to 1
                    For j = i + 1 To strString(i) + (((strString(i + 1)) - strString(i)) - 1) 'Loop through the new empty inserted columns and add quarter headers
                        Cells(1, j).Value = "Q" & strString(i) + k & "<>"
                        k = k + 1 'Add one quarter
                    Next j
                Else
                    Cells(1, i + 1).Value = "Q" & strString(i + 1) - ((strString(i + 1) - strString(i)) - 1) & "<>" 'Add Quarter headers if only one column was inserted
                End If
                '### --------------------------------------------------------------------- ###

            End If
        End If
    Next i
End Sub

Конечный результат:

Answer 2

вы можете избежать массивов:

Option Explicit

Sub Test()
    Dim lCol As Long, i As Long
    Dim qCurrent As Long, qPreceeding As Long

    With Sheets(1) 'reference your sheet
        lCol = .Cells(1, .Columns.Count).End(xlToLeft).Column ' start from referenced sheet row 1 last not empty column index
        Do While lCol > 1 ' start iterating from last column
            If Left(.Cells(1, lCol).Value, 1) = "Q" Then
                qCurrent = Val(Mid(.Cells(1, lCol).Value, 2)) ' get current column"Q" value
                qPreceeding = Val(Mid(.Cells(1, lCol - 1).Value, 2)) ' get preceeding column"Q" value

                If qCurrent > qPreceeding + 1 Then ' if current "Q" is not consecutive of preceeding one
                    .Cells(1, lCol).EntireColumn.Resize(, qCurrent - qPreceeding - 1).Insert ' insert columns
                    For i = 1 To qCurrent - qPreceeding - 1 'loop to recreate new headers
                        .Cells(1, lCol + i - 1).Value = "Q" & qPreceeding + i & "<>"
                    Next
                End If
            End If
            lCol = lCol - 1 ' step backwards
        Loop
    End With
End Sub

Answer 3

Вы объявили целые числа pos, pos1 и strStringas, после чего в своем коде вы используете их как массивы: pos (i), pos1 (i) и strString (i + 1). Вот почему вы получаете ошибку компиляции Expected Array.

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

Вам также необходимо полностью квалифицировать свои объекты. Ячейки без квалификатора, для которых лист будет использовать тот лист, который является активным, не обязательно тот, на который вы хотите повлиять.