Yritän poimia myyntitietoa työkirjasta toisiin osastokohtaisiin työkirjoihin päivämäärän perusteella. Päivämäärät näissä osastokohtaisissa työkirjoissa vain ovat eri muotoa kuin alkuperäisessä. Osastokohtaisissa on normaali päivämäärä (21.11.2008) ja kaikki vuoden päivät lueteltuna, mutta alkuperäisessä työkirjassa joka kuukaudelle on oma välilehti ja päivät on ilmoitettu muodossa 1, 2, 3 jne. Ja päivät lisääntyvät kuun edetessä, mutta joku päivä voi jäädä välistä poiskin.
Osastokohtaisissa työkirjoissa Sarakkeessa A on päivämäärä ja sarakkeen B soluihin haluaisin kerätä alkuperäisen työkirjan myyntitiedon.
Alkuperäisessä on sarakkeessa A kuukauden päivä numerona ja sarakkeissa B - L päivän myynti osastoittain.
Millä kaavalla saisin myyntitiedot kerättyä osastokohtaisiin työkirjoihin? En osaa vaikka kuinka yritän ja vanhoja ohjeita luen.
Tämä homma on tehtävä päivittäin, joten joku automaatio olisi helpottava. Nyt olen vain kopioinut päivän myynnit mutta se on hidasta ja virheitä aina välillä tulee.
Kiitos avusta!
Kaava hukassa
1
461
Vastaukset
originaalissa valitse haluamasi kuukausi välilehdeltä sarakkeesta A se päivämäärä, jonka rivitiedot haluat siirtää osastojen työkirjoihin
moduuliin...
Sub Siirrä()
Dim Päivä As Integer
Dim Kuukausi As String
Dim Vuosi As Integer
Dim Haku As String
Dim Myynti As Double
On Error Resume Next
Application.DisplayAlerts = False
Application.ScreenUpdating = False
If ActiveCell = "" Then
MsgBox "Valitsemasi solu on tyhjä!"
Exit Sub
End If
Päivä = ActiveCell
'MUUTA TEKSTI JOS TAULUKKO EI OLE NIMETTY TAMMIKUU, HELMIKUU...
'JOS TAMMI, HELMI... NIIN MUUTA TAMMI, HELMI...
Select Case UCase(ActiveSheet.Name)
Case "TAMMIKUU"
Kuukausi = 1
Case "HELMIKUU"
Kuukausi = 2
Case "MAALISKUU"
Kuukausi = 3
Case "HUHTIKUU"
Kuukausi = 4
Case "TOUKOKUU"
Kuukausi = 5
Case "KESÄKUU"
Kuukausi = 6
Case "HEINÄKUU"
Kuukausi = 7
Case "ELOKUU"
Kuukausi = 8
Case "SYYSKUU"
Kuukausi = 6
Case "LOKAKUU"
Kuukausi = 7
Case "MARRASKUU"
Kuukausi = 8
End Select
'MUUTA TARVITTAESSA
Vuosi = 2008
'MUUTA työkirjojen nimet b,c,d...
'B SARAKKEEN OSASTO
Myynti = ActiveCell.Offset(0, 1)
Haku = Päivä & "." & Kuukausi & "." & Vuosi
EtsiJaSiirrä Haku, Myynti, "b"
'C SARAKKEEN OSASTO
Myynti = ActiveCell.Offset(0, 2)
Haku = Päivä & "." & Kuukausi & "." & Vuosi
EtsiJaSiirrä Haku, Myynti, "c"
'D SARAKKEEN OSASTO
Myynti = ActiveCell.Offset(0, 3)
Haku = Päivä & "." & Kuukausi & "." & Vuosi
EtsiJaSiirrä Haku, Myynti, "d"
'E SARAKKEEN OSASTO
Myynti = ActiveCell.Offset(0, 4)
Haku = Päivä & "." & Kuukausi & "." & Vuosi
EtsiJaSiirrä Haku, Myynti, "e"
'F SARAKKEEN OSASTO
Myynti = ActiveCell.Offset(0, 5)
Haku = Päivä & "." & Kuukausi & "." & Vuosi
EtsiJaSiirrä Haku, Myynti, "f"
'G SARAKKEEN OSASTO
Myynti = ActiveCell.Offset(0, 6)
Haku = Päivä & "." & Kuukausi & "." & Vuosi
EtsiJaSiirrä Haku, Myynti, "g"
'H SARAKKEEN OSASTO
Myynti = ActiveCell.Offset(0, 7)
Haku = Päivä & "." & Kuukausi & "." & Vuosi
EtsiJaSiirrä Haku, Myynti, "h"
'I SARAKKEEN OSASTO
Myynti = ActiveCell.Offset(0, 8)
Haku = Päivä & "." & Kuukausi & "." & Vuosi
EtsiJaSiirrä Haku, Myynti, "i"
'J SARAKKEEN OSASTO
Myynti = ActiveCell.Offset(0, 9)
Haku = Päivä & "." & Kuukausi & "." & Vuosi
EtsiJaSiirrä Haku, Myynti, "j"
'K SARAKKEEN OSASTO
Myynti = ActiveCell.Offset(0, 10)
Haku = Päivä & "." & Kuukausi & "." & Vuosi
EtsiJaSiirrä Haku, Myynti, "k"
'L SARAKKEEN OSASTO
Myynti = ActiveCell.Offset(0, 11)
Haku = Päivä & "." & Kuukausi & "." & Vuosi
EtsiJaSiirrä Haku, Myynti, "l"
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Function EtsiJaSiirrä(Päiväys As String, Tieto As Double, Osasto As String) As Range
Dim Solu As Range
Dim Työkirja As Workbook
Päiväys = Format(Päiväys, "Short Date")
On Error Resume Next
'MUUTA POLKU
Set wb = Workbooks.Open("C:\Documents and Settings\Kunde\Omat tiedostot\" & Osasto & ".xls", False, False)
wb.Sheets(1).Activate
Set Solu = Cells.Find(What:=CDate(Päiväys), After:=Range("A1"), LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
Range(Solu.Address).Offset(0, 1) = Tieto
On Error GoTo 0
wb.Close True
End Function
Keep Excelling
@Kunde
Ketjusta on poistettu 0 sääntöjenvastaista viestiä.
Luetuimmat keskustelut
- 14910901
- 525200
Taas ryssittiin oikein kunnolla
r….ä hyökkäsi Viroon sikaili taas ajattelematta yhtään mitään https://www.is.fi/ulkomaat/art-2000011347289.html452413- 302113
Vanha Suola janottaa Iivarilla
Vanha suola janottaa Siikalatvan kunnanjohtaja Pekka Iivaria. Mies kiertää Kemijärven kyläjuhlia ja kulttuuritapahtumia131681Valtimon Haapajärvellä paatti mäni nurin
Ikävä onnettomuus Haapajärvellä. Vene hörpppi vettä matkalla saaren. Veneessä ol 5 henkilöä, kolme uiskenteli rantaan,421514Tiedän kuka sinä noista olet
Lucky for you, olen rakastunut sinuun joten en reagoi negatiivisesti. Voit kertoa kavereillesi että kyl vaan, rakkautta301221Känniläiset veneessä?
Siinä taas päästiin näyttämään miten tyhmiä känniläiset on. Heh heh "Kaikki osalliset ovat täysi-ikäisiä ja alkoholin v351166Daniel Nummelan linjapuhe 2025
Kansanlähetyksen toiminnanjohtajan Daniel Nummelan linjapuhe tänään. Rehellistä analyysiä mm. evlut kirkosta ja piispo92925TÄSTÄ TAITAA TULLA SUOMEN HISTORIAN SUURIN USKONNONVAPAUDEN OIKEUDENKÄYNTI.
Sinun täytyy hyväksyä se että jos sinä vetoat uskonnonvapauteen, silloin sinun tulee antaa myös muille vastaava vapaus o317882