Member 12726897 Ответов: 2

У меня есть такие данные в моем excel .из этого я хочу видеть свой необходимый вывод, как показано ниже, с помощью скрипта VBA.

a	1	2	3								
b	1	2	3								
c	1	2	3			


a	1	16	17								
b	12	15	16								
c	13	14	17



У меня есть такие данные в моем excel .Из этого я хочу видеть свой необходимый вывод, как показано ниже, с помощью скрипта vba.

Обязательный ОП: 
a	b	c									
1	1	1									
2	2	2									
3	3	3									
1	12	13									
16	15	14									
17	16	17


заранее спасибо.

Что я уже пробовал:

Option Explicit

Public Sub NormaliseData()

    Dim myRange, myDest, r As Range, i, n As Long
    
    'Change this range to encompass all your data
    Set myRange = Worksheets("Sheet5").Range("A1:D7")
    
    'Change this range to show where to start the new list
    Set myDest = Worksheets("Sheet6").Range("A1")
    
    With myRange
        For i = 1 To .Rows.Count
            For Each r In .Range(.Cells(i, 1), .Cells(i, .Columns.Count))
                If r.Column = myRange.Column Then
                    myDest.Value = r.Value
                ElseIf r.Value <> "" Then
                    myDest.Offset(0, 1).Value = r.Value
                    Set myDest = myDest.Offset(1, 0)
                Else
                    'do nothing
                End If
            Next r
        Next i
    End With

End Sub

Patrice T

И вы планируете объяснить, в чем проблема ?

2 Ответов

Рейтинг:
1

GoodJuJu

Ладно-попробуй вот это:

Option Explicit
 
Public Sub NormaliseData()
 
    Dim rngSource, rngDest As Range
    Dim intRow As Integer
    
    Dim strSourceSheet As String
    Dim strDestSheet As String
    
    strSourceSheet = "Sheet5"
    strDestSheet = "Sheet6"
    
    Worksheets(strSourceSheet).Select
    
    For intRow = 1 To Worksheets(strSourceSheet).UsedRange.Rows.Count
        If Worksheets(strSourceSheet).Range("A" & intRow).Value Like "a" Then
            If intRow = 1 Then
                Set rngSource = Worksheets(strSourceSheet).Range("A" & intRow & ":D" & intRow + 2)
            Else
                Set rngSource = Worksheets(strSourceSheet).Range("B" & intRow & ":D" & intRow + 2)
            End If
            
            Call fncTranspose(rngSource, rngDest, intRow, strDestSheet)
            
        End If
    Next intRow
    
MsgBox "Values have been transposed", vbOKOnly, "Transposed"
End Sub

Function fncTranspose(rngSource, rngDest, intRow, strDestSheet)

Dim intLastDestRow As Integer
intLastDestRow = Worksheets(strDestSheet).UsedRange.Rows.Count

Worksheets(strDestSheet).Select

If intRow = 1 Then
    Set rngDest = Worksheets(strDestSheet).Range("A" & intLastDestRow)
    rngSource.Copy
    rngDest.PasteSpecial Transpose:=True
Else
    Set rngDest = Worksheets(strDestSheet).Range("A" & intLastDestRow + 1)
    rngSource.Copy
    rngDest.PasteSpecial Transpose:=True
End If

End Function

Maciej Los

Вместо того чтобы публиковать другое решение, улучшите предыдущий ответ.

Рейтинг:
0

GoodJuJu

Будет ли просто "транспонирование" данных работать на вас?

Public Sub NormaliseData()
 
    Dim myRange, myDest, r As Range, i, n As Long
    
    'Change this range to encompass all your data
    Set myRange = Worksheets("Sheet5").Range("A1:D7")
    
    'Change this range to show where to start the new list
    Set myDest = Worksheets("Sheet6").Range("A1")
    
    myRange.Copy
    myDest.PasteSpecial Transpose:=True

End Sub

Member 12726897

Выполняя приведенный выше код, он возвращает вывод, как показано ниже.
А Б В А Б в
1 1 1 1 12 13
2 2 2 16 15 14
3 3 3 17 16 17

Но я хочу, чтобы операция была следующей

a b c
1 1 1
2 2 2
3 3 3
1 12 13
16 15 14
17 16 17

Заранее спасибо.

GoodJuJu

Это ваши фактические данные, A b c... или есть определенный заголовок, который меняется с каждой "партией"?