Pomoc w programowaniu, odpowiedzi na pytania / Przewyższać / Przenoszenie wierszy do pojedynczej kolumny podczas kopiowania danych w innych kolumnach - excel, vba, transpose

Przenoszenie wierszy do pojedynczej kolumny podczas kopiowania danych w innych kolumnach - excel, vba, transpose

Wyodrębniam dane z SQL i niektórych wierszymuszą być transponowane do kolumny podczas kopiowania innych danych, które są unikalne dla tej tabeli Potrzebujesz formuły, aby przeczytać wszystkie kolumny i wkleić nowe wiersze i skopiować dane. To tylko przykład, w zależności od tego, ile razy będę musiał przetransponować tyle wierszy w jednej kolumnie. Dane oryginalne to 50 000 wierszy Wszelkie sugestie są mile widziane

Przed

Order   Line    Item    Day Day2   Day3  Day4  Day5  Day6   Day7
2000    1      Apple    Mon Tue    Wed         Fri   Sat    Sun
2000    2      Orange   Mon               Thu               Sun
etc...

Order   Line    Item    Day
2000    1       Apple   Mon
2000    1       Apple   Tue
2000    1       Apple   Wed
2000    1       Apple   Fri
2000    1       Apple   Sat
2000    1       Apple   Sun
2000    2      Orange   Mon
2000    2      Orange   Thu
2000    2      Orange   Sun

Odpowiedzi:

0 dla odpowiedzi № 1

Oto szybki i brudny sposób na zrobienie tego. Może to potrwać kilka minut, ale to właśnie zajmuje, gdy mamy do czynienia z wieloma wierszami.

50 000 x 7 = 350 000 wierszy, więc możesz umieścić dane wyjściowe w innym arkuszu, jeśli masz najnowszą wersję programu Excel. Jestem w 2010 roku, a limit rzędu wynosi 1 048 576.

Zakłada to, że dane znajdują się na Arkuszu 1, a my zapiszemy je do Arkusza2.

W tobie VBA IDE przejdź do menu narzędzi i wybierz referencje. Wybierz "Obiekty danych Microstoft ActiveX 2.8 Library.

Private Sub CommandButton1_Click()

Dim ws   As Excel.Worksheet
Dim rs   As New ADODB.Recordset
Dim lRow As Long

"Add fields to your recordset for storing data.  This is how we will store the original data so we can process it after we read it.
With rs
.Fields.Append "Order", adInteger
.Fields.Append "Line", adInteger
.Fields.Append "Item", adChar, 25
.Fields.Append "Day", adChar, 10
.Fields.Append "Day2", adChar, 10
.Fields.Append "Day3", adChar, 10
.Fields.Append "Day4", adChar, 10
.Fields.Append "Day5", adChar, 10
.Fields.Append "Day6", adChar, 10
.Fields.Append "Day7", adChar, 10
.Open
End With

lRow = 2 "Start at two if there is a header row...
Set ws = ActiveWorkbook.Sheets("Sheet1")
ws.Activate

"Loop through the rows and record the data
Do While lRow <= ws.UsedRange.Rows.count

If ws.Range("A" & lRow).Value <> "" Then
rs.AddNew
rs.Fields("Order").Value = ws.Range("A" & lRow).Value
rs.Fields("Line").Value = ws.Range("B" & lRow).Value
rs.Fields("Item").Value = ws.Range("C" & lRow).Value
rs.Fields("Day").Value = ws.Range("D" & lRow).Value
rs.Fields("Day2").Value = ws.Range("E" & lRow).Value
rs.Fields("Day3").Value = ws.Range("F" & lRow).Value
rs.Fields("Day4").Value = ws.Range("G" & lRow).Value
rs.Fields("Day5").Value = ws.Range("H" & lRow).Value
rs.Fields("Day6").Value = ws.Range("I" & lRow).Value
rs.Fields("Day7").Value = ws.Range("J" & lRow).Value
rs.Update
End If

lRow = lRow + 1
ws.Range("A" & lRow).Activate
Loop

"Switch to the second worksheet
Set ws = Nothing
Set ws = ActiveWorkbook.Sheets("Sheet2")
ws.Activate

lRow = 1

If rs.RecordCount > 0 Then
rs.MoveFirst
End If

Do While rs.EOF = False

If Trim(rs.Fields("Day").Value) <> "" Then
ws.Range("A" & lRow).Value = rs.Fields("Order").Value
ws.Range("B" & lRow).Value = rs.Fields("Line").Value
ws.Range("C" & lRow).Value = rs.Fields("Item").Value
ws.Range("D" & lRow).Value = rs.Fields("Day").Value
lRow = lRow + 1
End If

If Trim(rs.Fields("Day2").Value) <> "" Then
ws.Range("A" & lRow).Value = rs.Fields("Order").Value
ws.Range("B" & lRow).Value = rs.Fields("Line").Value
ws.Range("C" & lRow).Value = rs.Fields("Item").Value
ws.Range("D" & lRow).Value = rs.Fields("Day2").Value
lRow = lRow + 1
End If

If Trim(rs.Fields("Day3").Value) <> "" Then
ws.Range("A" & lRow).Value = rs.Fields("Order").Value
ws.Range("B" & lRow).Value = rs.Fields("Line").Value
ws.Range("C" & lRow).Value = rs.Fields("Item").Value
ws.Range("D" & lRow).Value = rs.Fields("Day3").Value
lRow = lRow + 1
End If

If Trim(rs.Fields("Day4").Value) <> "" Then
ws.Range("A" & lRow).Value = rs.Fields("Order").Value
ws.Range("B" & lRow).Value = rs.Fields("Line").Value
ws.Range("C" & lRow).Value = rs.Fields("Item").Value
ws.Range("D" & lRow).Value = rs.Fields("Day4").Value
lRow = lRow + 1
End If

If Trim(rs.Fields("Day5").Value) <> "" Then
ws.Range("A" & lRow).Value = rs.Fields("Order").Value
ws.Range("B" & lRow).Value = rs.Fields("Line").Value
ws.Range("C" & lRow).Value = rs.Fields("Item").Value
ws.Range("D" & lRow).Value = rs.Fields("Day5").Value
lRow = lRow + 1
End If

If Trim(rs.Fields("Day6").Value) <> "" Then
ws.Range("A" & lRow).Value = rs.Fields("Order").Value
ws.Range("B" & lRow).Value = rs.Fields("Line").Value
ws.Range("C" & lRow).Value = rs.Fields("Item").Value
ws.Range("D" & lRow).Value = rs.Fields("Day6").Value
lRow = lRow + 1
End If

If Trim(rs.Fields("Day7").Value) <> "" Then
ws.Range("A" & lRow).Value = rs.Fields("Order").Value
ws.Range("B" & lRow).Value = rs.Fields("Line").Value
ws.Range("C" & lRow).Value = rs.Fields("Item").Value
ws.Range("D" & lRow).Value = rs.Fields("Day7").Value
lRow = lRow + 1
End If

ws.Range("A" & lRow).Activate
rs.MoveNext
Loop
End Sub

0 dla odpowiedzi nr 2

Może możesz zmodyfikować zapytanie SQL, aby bezpośrednio zwrócić wyniki używając UNION, na przykład? :

SELECT "Order", Line, Item, Day1 AS Day
FROM Table1 as T1
WHERE NOT IsNull(Day1)
UNION
SELECT "Order", Line, Item, Day2 AS Day
FROM Table1
WHERE NOT IsNull(Day2)
UNION
SELECT "Order", Line, Item, Day3 AS Day
FROM Table1
WHERE NOT IsNull(Day3)
UNION
SELECT "Order", Line, Item, Day4 AS Day
FROM Table1
WHERE NOT IsNull(Day4)
UNION
SELECT "Order", Line, Item, Day5 AS Day
FROM Table1
WHERE NOT IsNull(Day5)
UNION
SELECT "Order", Line, Item, Day6 AS Day
FROM Table1
WHERE NOT IsNull(Day6)
UNION
SELECT "Order", Line, Item, Day7 AS Day
FROM Table1
WHERE NOT IsNull(Day7)