Prenos 'trimanih' celic

Pomoč pri izdelavi makrov
Odgovori
b92
Prispevkov: 12
Pridružen: To Jun 23, 2009 3:09 pm

Prenos 'trimanih' celic

Odgovor Napisal/-a b92 »

Prosim za nasvet
kako prenesem del polja iz ene tabele v drugo.

V neko tabelo prepisujem del vsebine celice (zadnji 8 znakov) iz tabele Konstante011.xlsx.

Zgodi se, da mi vsebino celice pravilni prenese
obenem pa popravi celico iz katere prenašam zadnih 8 znakov.

Hvala za pomoč.

Koda: Izberi vse

Sub MakroTrim()

' Trimanje podatka iz tabele, samo zadnjih 8 znakov iz celice
    
    Dim wb    As Workbook         ' tu si bomo zapomnili delovni zvezek
    Dim polje As String           ' delovno polje
  
    Workbooks.Open Filename:="Konstante011.xlsx"
  
    Set wb = ActiveWorkbook       ' zapomnimo si kazalec na delovni zvezek
    
    Range("A4").Select
    Selection.Copy
    polje = Selection
    
    ' Selection = Right(Selection, 8)   ' <--- napaka, tu spremeni polje v trenutni tabeli
    ' Selection = Trim(Selection)
           
    polje = Right(polje, 8)   ' ???
    polje = Trim(polje)       ' ???
    
    Windows("Skupna.xls").Activate
    Range("D2").Selection
    ActiveSheet.Paste
    
    ActiveWorkbook.Close SaveChanges = False

End Sub
admin
Site Admin
Prispevkov: 3687
Pridružen: Sr Jul 20, 2005 10:06 pm

Re: Prenos 'trimanih' celic

Odgovor Napisal/-a admin »

Pozdravljeni,

Jasno, da vam popravlaj podatke, sej popravljate 'Selection' in to je pač izbrana celica, ki je v vašem primeru originalna celica -> to je tista, ki je trenutno izbrana. Vaš makro bi deloval, če bi vsebin najprek kopirali, jo nato izbrali in potem popravljali...

Seveda pa je vseskupaj povesm nesmiselno, saj zakaj bi podatke sploh kopirači na odlagališče in nazaj (kar je potratno), če jih lahko kar lepo prepisujete. Spodaj vam prilagam popravljen makro, ki ga seveda nisem preizkušal, temveč ga pišem direktno v forum, zato je možna kakšna hmentična napaka:

Koda: Izberi vse

Sub MakroTrim()
  Dim wb As Workbook
  Dim ws As Worksheet
  
  Workbooks.Open Filename:="Konstante011.xlsx"
  Set wb = ActiveWorkbook       ' zapomnimo si kazalec na delovni zvezek
  Set ws = ActiveSheet
  
  Windows("Skupna.xls").Activate
  Range("D2") = Trim(Right(ws.Range("a4"), 8))
  
  wb.Close SaveChanges:=False
End Sub
lp,
Matjaž Prtenjak
Administrator
b92
Prispevkov: 12
Pridružen: To Jun 23, 2009 3:09 pm

Re: Prenos 'trimanih' celic

Odgovor Napisal/-a b92 »

Hvala za pomoč. Deluje.

Imam še eno vprašanje.
Podatke prenašam iz dveh tabel.
Polje iz prve tabele prenese pravilno na zahtevano mesto (D2).
Polje iz druge tabele pa prenese na lokacijo prejšnjega prenosa (D2),
ne preskoči v novo vrstico (D3).

Hvala za pomoč.

Koda: Izberi vse

Sub MakroTrim()

' +-------------------------------------------------------------+
' ! Trimanje podatka iz tabele, samo zadnjih 8 znakov iz celice !
' +-------------------------------------------------------------+
    Dim wb    As Workbook         ' tu si bomo zapomnili delovni zvezek
' +--------------------------+
' ! TABELA Konstante011.xlsx !
' +--------------------------+
    Workbooks.Open Filename:="Konstante011.xlsx"
  
    Set wb = ActiveWorkbook       ' zapomnimo si kazalec na delovni zvezek
    Set ws = ActiveSheet
    
    Windows("Skupna.xls").Activate
    
    Range("D2") = Trim(Right(ws.Range("A4"), 8))
    
    If Range("D2").Offset(1, 0) <> "" Then
       Range("D2").End(xlDown).Select
    End If
  
    wb.Close SaveChanges:=False
    
' +--------------------------+
' ! TABELA Konstante012.xlsx !
' +--------------------------+
    Workbooks.Open Filename:="Konstante012.xlsx"
  
    Set wb = ActiveWorkbook       ' zapomnimo si kazalec na delovni zvezek
    Set ws = ActiveSheet
    
    Windows("Skupna.xls").Activate
    
    Range("D2") = Trim(Right(ws.Range("A4"), 8))
    
    If Range("D2").Offset(1, 0) <> "" Then
       Range("D2").End(xlDown).Select
    End If
     
    ActiveCell.Offset(1, 0).Select
    ' ActiveSheet.Paste                  <<----- ??? -----
    wb.Close SaveChanges:=False
    
End Sub

admin
Site Admin
Prispevkov: 3687
Pridružen: Sr Jul 20, 2005 10:06 pm

Re: Prenos 'trimanih' celic

Odgovor Napisal/-a admin »

Pozdravljeni,

In kaj bi vi sploh želeli početi? Kopirate podatek v D2... OK. Potem se po stolpcu D prestavite navzdol in tja nekaj kopirate... Od kot pa kopirate. Imate samo ukaz Paste. Kje pa je Copy? ter tudi zakaj bi vam karkoli kopiralo v celico D3, saj vi pišete v celico D2 v obeh zvezkih, nakar se pač prestavite na zadnjo polno celico v koloni D, ki pa ni nujno D3...
lp,
Matjaž Prtenjak
Administrator
b92
Prispevkov: 12
Pridružen: To Jun 23, 2009 3:09 pm

Re: Prenos 'trimanih' celic

Odgovor Napisal/-a b92 »

Problem izgleda sledeče.
Imam tabele Konstante011 .. Konstante01n.

V celici tabele Konstante011, A4, je zapisana neka vsebina, od katere me zanima samo zadnjih osem znakov.
Zadnih osem znakov vsebine prve tabele Konstante011, celica A4, izrežem in zapišem v tabelo Skupna, celica D2.

Iz naslednje tabele Konstante012 zadnih osem znakov iz celice A4 izrežem in prepišem v tabelo Skupna, celica D3.
In tako naprej do tabele Konstante01n v tabelo Skupna do celice Dn.

Podatek iz prve tabele Konstante011 je pravilno izrezan iz celice A4 in zapisan v celico D2.
Prestavim se na tabelo Konstante012 izrežem podatek iz celice A4. Rad bi ga zapisal v celico D3.
Ne gre mi preskok iz celice D2 na celico D3.

Upam, da sem razumljivo predstavil moj problem oz. neznanje.

LP
admin
Site Admin
Prispevkov: 3687
Pridružen: Sr Jul 20, 2005 10:06 pm

Re: Prenos 'trimanih' celic

Odgovor Napisal/-a admin »

In, če želite pisati v celico D3, zakaj tega potem ne storite - enako, kot sem vam pokazal za celico D2?

Koda: Izberi vse

Sub MakroTrim()

' +-------------------------------------------------------------+
' ! Trimanje podatka iz tabele, samo zadnjih 8 znakov iz celice !
' +-------------------------------------------------------------+
    Dim wb    As Workbook         ' tu si bomo zapomnili delovni zvezek
' +--------------------------+
' ! TABELA Konstante011.xlsx !
' +--------------------------+
    Workbooks.Open Filename:="Konstante011.xlsx"
 
    Set wb = ActiveWorkbook       ' zapomnimo si kazalec na delovni zvezek
    Set ws = ActiveSheet
   
    Windows("Skupna.xls").Activate
    Range("D2") = Trim(Right(ws.Range("A4"), 8))
    wb.Close SaveChanges:=False
   
' +--------------------------+
' ! TABELA Konstante012.xlsx !
' +--------------------------+
    Workbooks.Open Filename:="Konstante012.xlsx"
 
    Set wb = ActiveWorkbook       ' zapomnimo si kazalec na delovni zvezek
    Set ws = ActiveSheet
   
    Windows("Skupna.xls").Activate
    Range("D3") = Trim(Right(ws.Range("A4"), 8))
    wb.Close SaveChanges:=False
   
End Sub
lp,
Matjaž Prtenjak
Administrator
Odgovori