Excel 2007

[YorgosP]

Γεια σας.

Γνωρίζει κανείς να μου δώσει μια απάντηση στο παρακάτω πρόβλημα;

 

Έχω σε δύο στήλες Excel, στην Α και Β τα παρακάτω δεδομένα.

A1, A2, A3, A4, A5, A6,

&

B1, B2, B3, B4, B5, B6,

και θα ήθελα να ενώνονται σε μία και μοναδική στήλη (την C π.χ.) με την παρακάτω σειρά:

A1, A2, A3, A4, A5, A6, B1, B2, B3, B4, B5, B6,

 

Πάντα δηλαδή τα δεδομένα της στήλης Α να προηγούνται των δεδομένων της στήλης Β. Όμως:

Στα έξι κελιά της κάθε στήλης δεν θα υπάρχουν πάντα δεδομένα. Στη μία περίπτωση μπορεί να έχω 3 γεμάτα κελιά από την στήλη Α και 2 από την στήλη Β. Οπότε τα τελικά κελιά της στήλης C που θα γεμίσουν με δεδομένα από τις Α & Β να 5 και όχι 12. Θα έχω δηλαδή την εξής σειρά δεδομένων στην C

A1, A2, A3, B1, B2,

Στην άλλη περίπτωση να έχω 0 γεμάτα κελιά από τα έξι της στήλης Α και 6 από τα έξι της στήλης Β. Οπότε στην C θα έχω 6.

Θα έχω δηλαδή την εξής σειρά δεδομένων στην C

B1, B2, B3, B4, B5, B6,

Υπάρχει κάποια συνάρτηση που μπορώ να χρησιμοποιήσω ή κάτι άλλο τέλος πάντων;

Ευχαριστώ εκ των προτέρων.

Γιώργος

[australis]

Function δεν ξερω καποια να το κανει

Αν θελεις ομως μπορεις να το κανεις με τη παρακατω μακροεντολη

 

>
Public Sub merge_ABtoC()
Sheets("Sheet1").Select
Application.ScreenUpdating = False
Range("A1:A6").Select
Selection.Copy
Range("C1").Select
ActiveSheet.Paste
Range("B1:B6").Select
Selection.Copy
Range("C7").Select
ActiveSheet.Paste
Range("C1").Select
For i = 1 To 12
 If ActiveCell.Value = "" Then _
	 Selection.Delete Shift:=xlUp Else _
	 ActiveCell.Offset(1, 0).Select
Next i
Application.ScreenUpdating = True
End Sub

 

Αυτη δουλευει ομως μονο για τις στηλες Α & Β και 6 γραμμες

 

Αν θελεις κατι γενικοτερο θες κατι τετοιο

 

>
Public Sub merge_colums()
Dim rng As String
Dim i As Integer
Sheets("Sheet1").Select
Application.ScreenUpdating = False
Range("A1").Select
If ActiveCell.Value = "" Then ActiveCell.Value = "Temporary_Entry"
Row = ActiveSheet.UsedRange.Rows.Count
Col = ActiveSheet.UsedRange.Columns.Count
If ActiveCell.Value = "Temporary_Entry" Then ActiveCell.Value = ""
For i = 1 To Col
 rng = ColLett(i) + "1:" + ColLett(i) + CStr(Row)
 Range(rng).Select
 Selection.Copy
 Range(ColLett(Col + 1) + CStr(1 + Row * (i - 1))).Select
 ActiveSheet.Paste
Next i
i = 0
Range(ColLett(Col + 1) + "1").Select
Do
 If ActiveCell.Value = "" Then
	 Selection.Delete Shift:=xlUp
 Else
	 ActiveCell.Offset(1, 0).Select
 End If
 i = i + 1
Loop Until i >= Col * Row
Application.ScreenUpdating = True
End Sub
Public Function ColLett(Col As Integer) As String
If Col > 26 Then
 ColLett = ColLett((Col - (Col Mod 26)) / 26) + Chr(Col Mod 26 + 64)
Else
 ColLett = Chr(Col + 64)
End If
End Function

 

Μην ξεχασεις στη Sheets("Sheet1").Select να βαλεις το πραγματικο ονομα του sheet ....