Thema Datum  Von Nutzer Rating
Antwort
Rot Spalten kopieren und einfügen
11.10.2020 13:19:37 Lars
NotSolved
12.10.2020 00:28:23 Gast46534
NotSolved
13.10.2020 18:09:56 Lars
NotSolved

Ansicht des Beitrags:
Von:
Lars
Datum:
11.10.2020 13:19:37
Views:
59
Rating: Antwort:
  Ja
Thema:
Spalten kopieren und einfügen

Hallo zusammen!

Ich habe ein Problem mit einem Makro, welches ich schreiben will..

 Kurze Zusammenfassung der Funktion des Makros:

Ich gebe im Sheet(Ergebnis_Blatt) in Zeile 3 Spalte C einen Wert ein, der nur einmal vorkommt. Dieser Wert wird in Sheet(Rohdaten_Kunde) in Zeile 6 gesucht. Zu dem gesuchten Wert gehören immer bis zu 8000 Messungen die in der gleichen Spalte stehen. Die Messwerte sollen dann aus(Rohdaten_Kunde) herauskopiert und in (Ergebnis_Blatt) in Zeile 11 Spalte C eingefügt werden. Hinzu kommt noch das Problem, dass die Messwerte evtl. umgerechnet werden müssen, beispielsweise von kg in Tonnen. Der Umrechnungsfaktor ändert sich aber für die Messwerte einer Spalte NICHT. 

Der nächste gesuchte Wert wird dann in Zeile 3 Spalte D eingegeben und das Prozedere wird wiederholt.

Am besten sollen die Spalten nur bis zur letzten beschriebenen Zelle kopiert werden, um unnötigen Datenverbrauch zu vermeiden.

Was bekomme ich momentan hin:

1. Ich finde die Spalte in Rohdaten_Kunde 

2. Die Spalte des gefundenen Wertes mit Offset zu kopieren: Range(finden.offst(4,0,finden.offset(10000,0).copy

3. die gesuchte Spalte einzufügen --> hier fangen die Probleme an..

 

Wo ich Probleme habe:

1. Eine Spalte bis zur letzten beschriebenen Zelle anzusprechen range("B11:column.count.end.xlup")? Keine Ahnung wie die Syntax ist..

2. Die Messdaten in die Spalte einzufügen und dann für den nächsten Block an Messwerten des nächsten gesuchten Wertes eine Spalte weiter nach rechts zu springen 

3. Eine Spalte von Messwerten mit einem Faktor zu multiplizieren.

 

Mein Code bisher:

 

Sub KKS_Und_Spalte_Kopieren()

TestZeile = 1
a = 3
n = 1

For i = 3 To Worksheets("Ergebnis_Blatt").Cells(TestZeile, Columns.Count).End(xlToLeft).Column
        Worksheets("Rohdaten_Kunde").Activate
    Set finden = Range("B1:HB1").Find(What:=(Worksheets("Ergebnis_Blatt").Cells(5, a).Value))
        If Worksheets("Ergebnis_Blatt").Cells(5, a).Value = "" Then
        MsgBox "Sie haben nichts eingetragen!"
        Else
        finden.Copy Destination:=Worksheets("Ergebnis_Blatt").Cells(6, a)
    Set Bereich = ActiveSheet.Range("C11")
    finden.Select
    Range(finden.Offset(4, 0), finden.Offset(10000, 0)).Copy Destination:=Worksheets("Ergebnis_Blatt").Cells(6, a)
        End If

 a = a + 1
 n = n + 1
Next

End Sub



über eure Hilfe wäre ich sehr, sehr dankbar

viele Güße

euer verlorener Praktikant, Lars


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst genau und ausführlich
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
  • Bitte markieren Sie Ihre Anfrage als erledigt wenn Ihnen geholfen wurde
Thema: Name: Email:

 
 

Thema Datum  Von Nutzer Rating
Antwort
Rot Spalten kopieren und einfügen
11.10.2020 13:19:37 Lars
NotSolved
12.10.2020 00:28:23 Gast46534
NotSolved
13.10.2020 18:09:56 Lars
NotSolved