Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1728to1732
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Text in Spalte mit Makrofunktion

Text in Spalte mit Makrofunktion
12.12.2019 17:07:37
RO
Hallo zusammen,
ich habe folgende Code und funktioniert sehr gut.
Ich möchte nun, dass diese Code die Werte als Text in Tabelle (Abfrage_Export_GE) einfügt, d.h Text in Spalte, und in Spalte I und O von Tabelle (Abfrage_Export_GE) muss diese Code die Zahlen als Text und mit 2 nachkommastelle umwandeln (z.B. 5.15)
Das soll er machen, bevor er die Formel einfügt.
Das wäre sehr nett, wenn jemand mir dabei helfen kann.
Danke schön im Vorab.
Option Explicit
Sub GetAllUpdates()
Dim lLastRow As Long
Dim wkbOld As Workbook
Dim wkbNew As Workbook
Dim intCalculation As Integer
Const Abfrage_Export_DE As String = "R:\02_AUSWERTUNG_REPORTING\02_AUSWERTUNG\Abfrage_Export_DE.xlsx"
Const Abfrage_Export_EN As String = "R:\02_AUSWERTUNG_REPORTING\02_AUSWERTUNG\Abfrage_Export_EN.xlsx"
Application.ScreenUpdating = False
Application.EnableEvents = False
intCalculation = Application.Calculation
Application.Calculation = xlManual
Set wkbOld = ActiveWorkbook
Application.StatusBar = "delete old data"
With wkbOld.Sheets("Abfrage_Export_GE")
lLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
If lLastRow > 5 Then .Range("A2:AT" & lLastRow).ClearContents
End With
Application.StatusBar = "check if worksheet in this file does exist"
If WorksheetExists("Abfrage_Export_GE") Then
Sheets("Abfrage_Export_GE").Activate
Else
Application.StatusBar = "create missing worksheet"
Sheets.Add
ActiveSheet.Name = " Abfrage_Export_GE"
Sheets("Abfrage_Export_GE").Activate
End If
Application.StatusBar = "check if workbook " & Abfrage_Export_DE & " does exist, and open it"
If WkbExists(Abfrage_Export_DE) = False Then
If Dir(Abfrage_Export_DE) = "" Then
Else
Workbooks.Open Abfrage_Export_DE, UpdateLinks:=False
End If
Else
Workbooks(Abfrage_Export_DE).Activate
End If
Application.StatusBar = "check if worksheet in external file does exist"
Set wkbNew = ActiveWorkbook
If Not WorksheetExists("Abfrage_Export_DE") Then
Else
Application.StatusBar = "copy data"
wkbNew.Sheets("Abfrage_Export_DE").Activate
lLastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row
wkbNew.ActiveSheet.Range("A2:AT" & lLastRow).Copy
Application.StatusBar = "paste data"
wkbOld.Sheets("Abfrage_Export_GE").Range("A2").PasteSpecial xlPasteValues
wkbOld.Sheets("Abfrage_Export_GE").Range("A2").PasteSpecial xlPasteFormats
Application.CutCopyMode = False
End If
Application.StatusBar = "close file"
wkbNew.Close False
Application.StatusBar = "check if workbook " & Abfrage_Export_EN & " does exist, and open it"
If WkbExists(Abfrage_Export_EN) = False Then
If Dir(Abfrage_Export_EN) = "" Then
Else
Workbooks.Open Abfrage_Export_EN, UpdateLinks:=False
End If
Else
Workbooks(Abfrage_Export_EN).Activate
End If
Application.StatusBar = "check if worksheet in external file does exist"
Set wkbNew = ActiveWorkbook
If Not WorksheetExists("Abfrage_Export_EN") Then
Else
Application.StatusBar = "copy data"
wkbNew.Sheets("Abfrage_Export_EN").Activate
lLastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row
wkbNew.ActiveSheet.Range("A2:AT" & lLastRow).Copy
Application.StatusBar = "paste data"
lLastRow = wkbOld.Sheets("Abfrage_Export_GE").Cells(wkbOld.Sheets("Abfrage_Export_GE").Rows.Count, 1).End( _
xlUp).Row + 1
wkbOld.Sheets("Abfrage_Export_GE").Range("A" & lLastRow).PasteSpecial xlPasteValues
wkbOld.Sheets("Abfrage_Export_GE").Range("A" & lLastRow).PasteSpecial xlPasteFormats
Application.CutCopyMode = False
End If
Application.StatusBar = "close file"
wkbNew.Close False
Application.StatusBar = "copy formulas"
With wkbOld.Sheets("Abfrage_Export_GE")
lLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
If lLastRow > 2 Then
.Range("AW2:CJ2").Copy
.Range("AW3:CJ" & lLastRow).PasteSpecial
Application.CutCopyMode = False
End If
End With
End Sub

Private Function WkbExists(sFile As String) As Boolean
Dim wkb As Object
On Error Resume Next
Set wkb = Workbooks(sFile)
If Not wkb Is Nothing Then
WkbExists = True
End If
On Error GoTo 0
End Function


Public Function WorksheetExists(ByVal WorksheetName As String) As Boolean
On Error Resume Next
WorksheetExists = (Sheets(WorksheetName).Name  "")
On Error GoTo 0
End Function

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Folgendes ist unklar, ...
12.12.2019 18:05:37
Luc:-?
…RO:
Ich möchte nun, dass diese Code die Werte als Text in Tabelle (Abfrage_Export_GE) einfügt, d.h Text in Spalte, und in Spalte I und O von Tabelle (Abfrage_Export_GE) muss diese Code die Zahlen als Text und mit 2 nachkommastelle umwandeln (z.B. 5.15)
1. Handelt es sich hierbei um einen Text aus mehreren Werten, der mittels Text-in-Spalten auf mehrere Spalten aufgeteilt wdn soll, oder liegen die Werte alle schon einzeln vor?
2. Warum Zahlen als Text? Die Xl-Methode Text-in-Spalten wandelt doch schon alles nach Vorgabe um. Oder sollen unbedingt einzelne Zahlenwerte zu Text wdn? Warum? Es kann doch auch gleich das entsprd ZahlenFormat eingestellt wdn.
Gruß, Luc :-?
„Die universelle Befähigung zur Unfähigkeit macht jede menschliche Leistung zu einem unglaublichen Wunder.“ Stapps ironisches Paradoxon
Nichtsdestotrotz Durchblick verbessern mit …

Anzeige
AW: Folgendes ist unklar, ...
13.12.2019 09:44:16
RO
Hi,
danke für Antwort,
Die Werte werden kopiert und mit diesem Makro eingefügt. Für die Berechnung muss ich immer Blatt berechnen drucken, da scheinbar die Formel nicht die Werte erkennen. Deswegen vllt muss man für Spalte I und O immer Text in Spalten durchführen.
Es ist auch wichtig, dass die Spalte I und O auch die Zahlen mit 2 kommastellen hat. (z.b. 7,12)
Danke dir.
Ro

303 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige