von toO231 » Di, 21.12.2010 13:08
Hallo zusammen,
ich hab folgendes Problem mit einer For schleife^^
also es wird ein Wert von der 1ten Mappe in die 2te Mappe geschrieben, in diesem Fall ein Datumsfeld. Das funktioniert auch, nur will ich Doppeleintragungen vermeiden, und dazu will ich die gesamte spalte a (max.500 zeilen) mit dem Datum vergleichen, wenn es das Datum schon gibt, dann soll eine msgbox mit einem fehler kommen und ansonsten solls eingetragen werden... aber ich komm einfach nicht vorran :/ bitte helft mir, hier der code
Code: Alles auswählen
Option Explicit
Sub DatenUebernahme_strom()
Dim Z As Long
Dim oSrcSheet As Object, oDstSheet As Object, oZelle as Object, oDstSheet2 as Object
dim oList as Object, oList3 as Object
oList = ThisComponent.sheets(0).drawPage.Forms.getByIndex(0).getByName("strom_g")
oList3 = ThisComponent.sheets(0).drawpage.Forms(0).getByName("strom_d") ' Datumsfeld
for i = 9 to 500
oDstSheet2 = ThisComponent.sheets(1)
gleich = false
if oDstSheet2.getcellbyposition(0,i) <> oList3 Then
Next
EXIT For
oSrcSheet = ThisComponent.Sheets(0)
Select Case oList.currentValue
case "Schule"
oDstSheet = ThisComponent.sheets(1)
Z = getLastRowInColumn(oDstSheet, 0) + 1
'Anfang Datumsuebergabe
oZelle = thisComponent.sheets(1).getCellByPosition(0,Z)
oZelle.value = CDateFromISO(oList3.date)
'Ende Datumsuebergabe
prcCopyValue oSrcSheet.getCellRangeByName("b7"), oDstSheet.getCellByPosition(1,Z)
prcCopyValue oSrcSheet.getCellRangeByName("b8"), oDstSheet.getCellByPosition(2,Z)
Case "Sporthalle"
oDstSheet = ThisComponent.sheets(5)
Z = getLastRowInColumn(oDstSheet, 0) + 1
'Anfang Datumsuebergabe
oZelle = thisComponent.sheets(5).getCellByPosition(0,Z)
oZelle.value = CDateFromISO(oList3.date)
'Ende Datumsuebergabe
prcCopyValue oSrcSheet.getCellRangeByName("b9"), oDstSheet.getCellByPosition(2,Z)
prcCopyValue oSrcSheet.getCellRangeByName("b10"), oDstSheet.getCellByPosition(3,Z)
prcCopyValue oSrcSheet.getCellRangeByName("b11"), oDstSheet.getCellByPosition(4,Z)
prcCopyValue oSrcSheet.getCellRangeByName("b12"), oDstSheet.getCellByPosition(6,Z)
End Select
End Sub
Function getLastRowInColumn(oSheet as Object, iColumn as integer) as Long
dim oUsedCells as Object
oUsedCells = oSheet.Columns(iColumn).queryContentCells(23)
if oUsedCells.Count = 0 Then
getLastRowInColumn = -1
else
getLastRowInColumn = oUsedCells.RangeAddresses(oUsedCells.Count-1).endRow
endif
End Function
Sub prcCopyValue(oSrcRange as Object, oDstRange as Object)
dim arData as Variant
arData = oSrcRange.getDataArray()
oDstRange.setDataArray(arData)
End Sub
Wenn jemand noch eine bessere Idee hat bitte melden !
Vielen dank schonmal
Hallo zusammen,
ich hab folgendes Problem mit einer For schleife^^
also es wird ein Wert von der 1ten Mappe in die 2te Mappe geschrieben, in diesem Fall ein Datumsfeld. Das funktioniert auch, nur will ich Doppeleintragungen vermeiden, und dazu will ich die gesamte spalte a (max.500 zeilen) mit dem Datum vergleichen, wenn es das Datum schon gibt, dann soll eine msgbox mit einem fehler kommen und ansonsten solls eingetragen werden... aber ich komm einfach nicht vorran :/ bitte helft mir, hier der code
[code]Option Explicit
Sub DatenUebernahme_strom()
Dim Z As Long
Dim oSrcSheet As Object, oDstSheet As Object, oZelle as Object, oDstSheet2 as Object
dim oList as Object, oList3 as Object
oList = ThisComponent.sheets(0).drawPage.Forms.getByIndex(0).getByName("strom_g")
oList3 = ThisComponent.sheets(0).drawpage.Forms(0).getByName("strom_d") ' Datumsfeld
for i = 9 to 500
oDstSheet2 = ThisComponent.sheets(1)
gleich = false
if oDstSheet2.getcellbyposition(0,i) <> oList3 Then
Next
EXIT For
oSrcSheet = ThisComponent.Sheets(0)
Select Case oList.currentValue
case "Schule"
oDstSheet = ThisComponent.sheets(1)
Z = getLastRowInColumn(oDstSheet, 0) + 1
'Anfang Datumsuebergabe
oZelle = thisComponent.sheets(1).getCellByPosition(0,Z)
oZelle.value = CDateFromISO(oList3.date)
'Ende Datumsuebergabe
prcCopyValue oSrcSheet.getCellRangeByName("b7"), oDstSheet.getCellByPosition(1,Z)
prcCopyValue oSrcSheet.getCellRangeByName("b8"), oDstSheet.getCellByPosition(2,Z)
Case "Sporthalle"
oDstSheet = ThisComponent.sheets(5)
Z = getLastRowInColumn(oDstSheet, 0) + 1
'Anfang Datumsuebergabe
oZelle = thisComponent.sheets(5).getCellByPosition(0,Z)
oZelle.value = CDateFromISO(oList3.date)
'Ende Datumsuebergabe
prcCopyValue oSrcSheet.getCellRangeByName("b9"), oDstSheet.getCellByPosition(2,Z)
prcCopyValue oSrcSheet.getCellRangeByName("b10"), oDstSheet.getCellByPosition(3,Z)
prcCopyValue oSrcSheet.getCellRangeByName("b11"), oDstSheet.getCellByPosition(4,Z)
prcCopyValue oSrcSheet.getCellRangeByName("b12"), oDstSheet.getCellByPosition(6,Z)
End Select
End Sub
Function getLastRowInColumn(oSheet as Object, iColumn as integer) as Long
dim oUsedCells as Object
oUsedCells = oSheet.Columns(iColumn).queryContentCells(23)
if oUsedCells.Count = 0 Then
getLastRowInColumn = -1
else
getLastRowInColumn = oUsedCells.RangeAddresses(oUsedCells.Count-1).endRow
endif
End Function
Sub prcCopyValue(oSrcRange as Object, oDstRange as Object)
dim arData as Variant
arData = oSrcRange.getDataArray()
oDstRange.setDataArray(arData)
End Sub[/code]
Wenn jemand noch eine bessere Idee hat bitte melden !
Vielen dank schonmal