|
Morgen
Ich habe folgendes Anliegen. Eine txt-Datei soll eingelesen werden (zur Einfachheit erst einmal fester Pfad) auf einen extra sheet, dann sollen die Daten kontrolliert werden und auffällige Werte farblich markiert werden (siehe vorhandener Text), danach soll ein speichern des sheets als extra result.xls erfolgen und das zwischendurch erstellte sheet wieder gelöscht werden.
Hab nicht wirklich Ahnung von VBA und hatte bereits Not den Abgleich mit Normwerten hinzubekommen, aber auch damit wurde mir hier bereits geholfen:
Hierzu schon mal mein bis jetzt erstelltes:
Option Explicit
Sub AFREQ()
Dim wrkbook As Workbook
Set wrkbook = ActiveWorkbook
'hier definieren wir den namen der variable für dein workbook (name der .xls datei)
Dim max_x As Integer
max_x = wrkbook.Worksheets("eeg").UsedRange.Rows.Count
max_x = max_x
'hier lesen wir die anzahl zeilen aus und erstellen eine variabel für das ergebnis
Dim spalte As String
Dim X As Integer
Dim y As Integer
Dim z As Integer
z = 1
Dim a As Variant
Dim b As String
Dim c As String
Do
If z = 1 Then
spalte = "AFREQ_controls"
z = z + 1
ElseIf z = 2 Then
spalte = "AFREQ_cases"
z = z + 1
ElseIf z = 3 Then
spalte = "AFREQ_cc"
z = z + 1
End If
X = 1
y = 0
Do
y = y + 1
Loop Until wrkbook.Worksheets("eeg").Cells(X, y).Value = spalte Or y = 100
'es wird in der ersten Zeile nach gewünschtem Spaltennamen gesucht
X = X + 1
Do
a = Split(wrkbook.Worksheets("eeg").Cells(X, y).Value, "|") 'split-array, "|" ist der Trenner
b = a(0) 'b=erster Teil des arrays "a"
c = a(1) 'c=zweiter Teil des arrays "a"
If b <= "0.01" Or c >= "0.99" Then
wrkbook.Worksheets("eeg").Cells(X, y).Select
Selection.Interior.ColorIndex = 34
X = X + 1
Else
X = X + 1
End If
Loop Until X = max_x + 1
Loop Until z = 4
'programm durchläuft hier zelle um zelle bis es am ende ankommt (max_x = max Zeilenanzahl) und überprüft ob der inhalt < 0,01 oder über 0,99 ist ist fals nicht wird die zelle rot markiert...
End Sub
Sub HWE()
Dim wrkbook As Workbook
Set wrkbook = ActiveWorkbook
'hier definieren wir den namen der variable für dein workbook (name der .xls datei)
Dim max_x As Integer
max_x = wrkbook.Worksheets("eeg").UsedRange.Rows.Count
max_x = max_x
'hier lesen wir die anzahl zeilen aus und erstellen eine variabel für das ergebnis
Dim spalte As String
Dim X As Integer
Dim y As Integer
Dim z As Integer
z = 1
Do
If z = 1 Then
spalte = "HWE_controls"
z = z + 1
ElseIf z = 2 Then
spalte = "HWE_cases"
z = z + 1
ElseIf z = 3 Then
spalte = "HWE_cc"
z = z + 1
End If
X = 1
y = 0
Do
y = y + 1
Loop Until wrkbook.Worksheets("eeg").Cells(X, y).Value = spalte Or y = 100
'es wird in der ersten Zeile nach gewünschtem Spaltennamen gesucht
X = X + 1
Do
If wrkbook.Worksheets("eeg").Cells(X, y).Value <= 0.05 Then
wrkbook.Worksheets("eeg").Cells(X, y).Select
Selection.Interior.ColorIndex = 34
X = X + 1
Else
X = X + 1
End If
Loop Until X = max_x + 1
Loop Until z = 4
'programm durchläuft hier zelle um zelle bis es am ende ankommt (max_x = max Zeilenanzahl) und überprüft ob der inhalt < 0,01 oder über 0,99 ist ist fals nicht wird die zelle rot markiert...
End Sub
Sub P()
Dim wrkbook As Workbook
Set wrkbook = ActiveWorkbook
'hier definieren wir den namen der variable für dein workbook (name der .xls datei)
Dim max_x As Integer
max_x = wrkbook.Worksheets("eeg").UsedRange.Rows.Count
max_x = max_x
'hier lesen wir die anzahl zeilen aus und erstellen eine variabel für das ergebnis
Dim spalte As String
Dim X As Integer
Dim y As Integer
Dim z As Integer
z = 1
Do
If z = 1 Then
spalte = "P_controls"
z = z + 1
ElseIf z = 2 Then
spalte = "P_cases"
z = z + 1
ElseIf z = 3 Then
spalte = "P_cc"
z = z + 1
ElseIf z = 4 Then
spalte = "P_ADD_controls"
z = z + 1
ElseIf z = 5 Then
spalte = "P_ADD_cases"
z = z + 1
ElseIf z = 6 Then
spalte = "P_ADD_cc"
z = z + 1
End If
X = 1
y = 0
Do
y = y + 1
Loop Until wrkbook.Worksheets("eeg").Cells(X, y).Value = spalte Or y = 100
'es wird in der ersten Zeile nach gewünschtem Spaltennamen gesucht
X = X + 1
Do
If wrkbook.Worksheets("eeg").Cells(X, y).Value <= 0.00001 Then
wrkbook.Worksheets("eeg").Cells(X, y).Select
Selection.Interior.ColorIndex = 3
X = X + 1
ElseIf wrkbook.Worksheets("eeg").Cells(X, y).Value <= 0.001 Then
wrkbook.Worksheets("eeg").Cells(X, y).Select
Selection.Interior.ColorIndex = 45
X = X + 1
ElseIf wrkbook.Worksheets("eeg").Cells(X, y).Value <= 0.05 Then
wrkbook.Worksheets("eeg").Cells(X, y).Select
Selection.Interior.ColorIndex = 6
X = X + 1
Else
X = X + 1
End If
Loop Until X = max_x + 1
Loop Until z = 7
'programm durchläuft hier zelle um zelle bis es am ende ankommt (max_x = max Zeilenanzahl) und überprüft ob der inhalt < 0,01 oder über 0,99 ist ist fals nicht wird die zelle rot markiert...
End Sub
FAZIT: txt einlesen, temp. extra sheet, auswerten, sheet speichern als result.xls
man könnte sicherlich auch erst die daten einlesen, dann gleich speichern und dann erst die werte kontrollieren... wie das jetzt sinnvoller ist liegt nicht in meinem ermessensbereich :)
Vielen Dank schon mal fürs Lesen! :)
Falk
|