AW: Fehler im Code VBA
23.11.2010 23:38:33
dan
Hallo Andreas,
hier mein Code, hoffe es funzt.
Ich habe versuch die Aufgabe in einzelne Funktionen zu zerteilen, falls Du Fragen dazu haben solltest, bin ich bereit sie zu beantworten :-).
Gruss dan, cz.
---------------------------------------------------------------------------------------------
Option Explicit
Private Const SEARCHED_SHEET As String = "Bestellungen"
Private Const ARCHIVE_SHEET As String = "Bestellungen-Archiv"
Private Const SEARCHED_TEXT As String = "JA"
Private Const SEARCHED_COLUMN As String = "O"
Private m_searchInSheet As Worksheet
Private m_archivSheet As Worksheet
Private m_searchInRange As Range
Private m_searchResult As Range
Public Sub Start()
On Error GoTo ErrStart
Initialize
Application.ScreenUpdating = False
Set m_searchResult = FindIgnoreCase(m_searchInRange)
CopyToArchiv m_searchResult, m_archivSheet
ClearResult m_searchResult
Application.ScreenUpdating = True
Exit Sub
ErrStart:
Application.ScreenUpdating = True
MsgBox Err.Description
End Sub
Private Sub Initialize()
Set m_searchInSheet = Worksheets(SEARCHED_SHEET)
Set m_archivSheet = Worksheets(ARCHIVE_SHEET)
Set m_searchInRange = Application.Intersect(m_searchInSheet.UsedRange, m_searchInSheet. _
Columns(SEARCHED_COLUMN))
End Sub
Private Sub ClearResult(result As Range)
' Anschliessend sollen die markierten Werte (nicht die Zeilen) in Blatt Bestellungen gelö _
scht werden.
If (Not result Is Nothing) Then
result.Clear
End If
End Sub
Private Sub CopyToArchiv(data As Range, target As Worksheet)
' Diese werden dann in Blatt Bestellungen-Archiv übertragen, nur Werte und Zahlenformate.
' In die erste freie Zeile die in Spalte "B" keine Werte hat.
If (data Is Nothing) Then Exit Sub
Dim checkInColumn As String
checkInColumn = "B"
Dim targetRow As Integer
targetRow = target.Columns(checkInColumn).Cells(Rows.Count).End(xlUp).Row + 1
Dim targetColumn As Integer
targetColumn = 1
Dim oneRow As Range
For Each oneRow In data.Rows
oneRow.Copy
target.Cells(targetRow, targetColumn).PasteSpecial xlPasteFormats
target.Cells(targetRow, targetColumn).PasteSpecial xlPasteValues
targetRow = targetRow + 1
Next oneRow
End Sub
Private Function FindIgnoreCase(searchIn As Range) As Range
' ... soll in Blatt Bestellungen alle Zeilen die in Spalte "O" Wert "ja" haben markiert _
werden.
' Nur die Werte von Spalte "B-P"
Dim search
Dim startColumn As Integer
Dim endColumn As Integer
Dim result As Range
Dim oneCell As Range
startColumn = 2
endColumn = 16
Dim resultRow As Range
For Each oneCell In searchIn
Set resultRow = searchIn.Worksheet.Range(searchIn.Worksheet.Cells(oneCell.Row, 2), _
searchIn.Worksheet.Cells(oneCell.Row, 16))
If (Strings.StrComp(SEARCHED_TEXT, Strings.UCase(oneCell.text)) = 0) Then
If (result Is Nothing) Then
Set result = resultRow
Else
Set result = Application.Union(result, resultRow)
End If
End If
Next oneCell
Set FindIgnoreCase = result
End Function