..|| Blog || Produkti/Storitve || MExcel || MDodatki || 300 nasvetov ||..

Prenos 'trimanih' celic

Pomoč pri izdelavi makrov

Prenos 'trimanih' celic

OdgovorNapisal/-a b92 » Ne nov 19, 2017 1:34 pm

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
b92
 
Prispevkov: 12
Pridružen: To jun 23, 2009 3:09 pm



Matjazev.NET
 

Re: Prenos 'trimanih' celic

OdgovorNapisal/-a admin » Ne nov 19, 2017 3:46 pm

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
admin
Site Admin
 
Prispevkov: 3529
Pridružen: Sr jul 20, 2005 10:06 pm

Re: Prenos 'trimanih' celic

OdgovorNapisal/-a b92 » Po nov 20, 2017 7:35 pm

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

b92
 
Prispevkov: 12
Pridružen: To jun 23, 2009 3:09 pm

Re: Prenos 'trimanih' celic

OdgovorNapisal/-a admin » To nov 21, 2017 8:46 am

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
admin
Site Admin
 
Prispevkov: 3529
Pridružen: Sr jul 20, 2005 10:06 pm

Re: Prenos 'trimanih' celic

OdgovorNapisal/-a b92 » Sr nov 22, 2017 1:10 am

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
b92
 
Prispevkov: 12
Pridružen: To jun 23, 2009 3:09 pm

Re: Prenos 'trimanih' celic

OdgovorNapisal/-a admin » Sr nov 22, 2017 9:59 pm

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
admin
Site Admin
 
Prispevkov: 3529
Pridružen: Sr jul 20, 2005 10:06 pm


Vrni se na VBA

Kdo je prisoten

Po forumu brska: 0 registriranih uporabnikov in 1 gost

cron