Excel Microsoft Reihe in Spalte

...komplette Frage anzeigen

2 Antworten

Sub Drehe_Matrix()
'Makro legt eine neues Tabellenblatt an und übernimmt die Werte
' (keine Formate und Formeln!) aus den Zeilen dann in die Spalten.
'        (aus Reihen werden Spalten und aus Spalten Reihen)
'Geschrieben am 13.6.2009 R_Scheidler

Dim MyRowAsk As String
Dim MyRow As Double
Dim TheRow As Double
Dim MyColAsk As String
Dim MyCol As Double
Dim TheCol As Double
Dim Abfrage As String
Dim Titel As String
Dim Dummy As String
Dim Reihe As Double
Dim Spalte As Double
Dim Act_WS As String
Dim This_WorkSheet
Dim Vorhanden As Single
Dim Transporter As Variant

Reihe = ActiveCell.Row
Spalte = ActiveCell.Column
Act_WS = ActiveSheet.Name

If Act_WS = "Matrix gedreht" Then
    Titel = "Fehler bei der Fstlegung des Blattes"
''    Abfrage = "Das aktuelle Blatt ist als Ziel definiert." & vbCr
    Abfrage = "Das aktuelle Blatt ist als Ziel definiert." & Chr(13) & _"Es kann daher nicht gedreht werden!" & Chr(13) & Chr(13) & _"Benennen Sie das Blatt um und versuchen es dann erneut"Dummy = MsgBox(Abfrage, vbOKOnly, Titel)
    Exit Sub
End IfFor Each This_WorkSheet In WorksheetsIf This_WorkSheet.Name = "Matrix gedreht" ThenVorhanden = 2ElseEnd If
    Next This_WorkSheet
    If Vorhanden <> 2 ThenActiveWorkbook.Sheets.Add After:=ActiveSheetActiveSheet.Name = "Matrix gedreht"
    End If

Sheets(Act_WS).Select
Cells(Reihe, Spalte).Select


Titel = "Ermittlung der Grenzen"

Abfrage = "Welches ist die letzte senkrechte Zelle," & Chr(13) & _"bitte nur die Zahl angeben (z.B. 124 bei CF124)?"

MyRowAsk = Zahl_aus_Text(InputBox(Abfrage, Titel))
If MyRowAsk = "" Then MyRowAsk = 257
If MyRowAsk > 256 Then
    Dummy = MsgBox("Zuviele Reihen", vbOKOnly, Titel)
    Exit Sub
End If
If MyRowAsk = 0 Then
    Dummy = MsgBox("Keine Reihen?", vbOKOnly, Titel)
    Exit Sub
End If

Range("A1:A" & MyRowAsk).Select
MyRow = Selection.Rows.Count


Abfrage = "Welches ist die letzte waagerechte Zelle," & Chr(13) & _"bitte nur den/die Buchstaben angeben (z.B. CF bei CF124)?"

MyColAsk = UCase(Text_aus_Text(InputBox(Abfrage, Titel)))
If MyColAsk = "" Then MyRowAsk = "IW"
If (Len(MyColAsk) > 1 And MyColAsk > "IV") Or Len(MyColAsk) > 2 Then
    Dummy = MsgBox("Zuviele Spalten", vbOKOnly, Titel)
    Exit Sub
End If

Range("A1:" & MyColAsk & "1").Select
MyCol = Selection.Columns.Count

For TheRow = 1 To MyRow
    For TheCol = 1 To MyCol
'       ################## Werte #####################################Worksheets("Matrix gedreht").Cells(TheCol, TheRow) = _Worksheets(Act_WS).Cells(TheRow, TheCol)
    Next TheCol
Next TheRow

End Sub
'#################################################
Falls oben der Code verhunzt wurde - (Computer, Excel)
TuckerCase 21.01.2011, 15:34

kleine empfehlung: besser keine selects verwenden

warum so eine komplizierte prozedur?

warum nicht transpose verwenden? bzw einfachere prüfungen und schleifen?

0

Kopieren; In andere Tabelle wechseln; Bearbeiten, Inhalte Einfügen, Transponieren.

Was möchtest Du wissen?