Creare macrou dupa inserare fisier sursa

Ce este nou in Microsoft Excel 2016?
Informatii despre cum se utilizeaza Microsoft Excel 2016
Calcule, Formule, Functii, Tabele pivot, Analiza datelor, etc
Închis
razzvan_17
Mesaje: 10
Membru din: Mie Dec 17, 2014 8:59 am

Creare macrou dupa inserare fisier sursa

Mesaj de razzvan_17 » Joi Mar 01, 2018 9:42 am

Buna ziua,

Incerc de ceva timp sa creez un macrou pentru a imi simplifica cu mult activitatea.
Apelez la profesionalismul vostru pentru a ma indruma in realizarea fisierului.
Atasez urmatorul fisier si incerc sa explic dorinta mea :

In prima pagina denumita test , sunt date ce le extrag cu un program . Doresc ca acest fisier sa il inserez cu ajutorul unui buton iar macroul sa imi calculeze urmatorele date: sa caute in acest fisier sursa ecartul pe linie cu linie, rand cu rand si sa mi afiseze in pagina 2 diferenta, de ex:
Din S10 in S11 a evoluat cu eliminarea celor doua operatii de la randurile 47,48 coloanele B si C . In coloanele I si J au fost aduse mai de jos operatiile care in S10 erau la 49,50
Eu ca sa pot face diferenta de DST / TPR inserez doua randuri in S11 la 47 pentru a le pune in ordine rand cu rand , coloana cu coloana.

Multumesc pentru ajutor!
Nu aveţi permisiunea de a vizualiza fişierele ataşate acestui mesaj.

TudyBTH
Moderator
Moderator
Mesaje: 993
Membru din: Joi Feb 11, 2016 2:12 pm
Localitate: Cluj Napoca

Re: Creare macrou dupa inserare fisier sursa

Mesaj de TudyBTH » Joi Mar 01, 2018 12:47 pm

Buna,

Aveti mai jos un cod care cauta corespondentul liniei din S10 in S11 (dupa campurile TecTron si N FOP).
Rezultatul va contine TOATE LINIILE DIN S10 si liniile din S11 corespondente.

Cod: Selectaţi tot

Sub InsertSursa()
    
    '============================================
    Const wsSursaName As String = "Test1"
    Const wsRezName As String = "Rezultat"
    Const s10Addr As String = "A8"
    Const s11Addr As String = "I8"
    '============================================
    
    Dim arrS10() As Variant, arrS11() As Variant, arrRez() As Variant
    Dim wsS As Worksheet, wsR As Worksheet
    Dim r As Range, rTbl As Range
    Dim lr As Long, i As Long, j As Long
    Dim k As Integer
    Dim TecTron As String, n_FOP As String
    
    With ThisWorkbook
        Set wsS = .Sheets(wsSursaName)
        Set wsR = .Sheets(wsRezName)
    End With
    Application.ScreenUpdating = False
    
    'sterge datele din Rezultat
    Set r = wsR.Range(s10Addr)
    lr = wsR.Cells(wsR.Rows.Count, r.Column).End(xlUp).Row - r.Row
    If lr > 0 Then r.Resize(lr, 15).ClearContents
    
    'copiaza datele sursa
    Set r = wsS.Range(s10Addr)
    lr = wsS.Cells(wsS.Rows.Count, r.Column).End(xlUp).Row - r.Row
    Set rTbl = r.Offset(1, 0).Resize(lr, 7)
    arrS10 = rTbl
    
    Set r = wsS.Range(s11Addr)
    lr = wsS.Cells(wsS.Rows.Count, r.Column).End(xlUp).Row - r.Row
    Set rTbl = r.Offset(1, 0).Resize(lr, 7)
    arrS11 = rTbl
    
    'insereaza datele sursa in rezultat
    ReDim arrRez(1 To UBound(arrS10, 1), 1 To 15)
    For i = 1 To UBound(arrS10, 1)
        TecTron = arrS10(i, 1)
        n_FOP = arrS10(i, 2)
        For k = 1 To 7
            arrRez(i, k) = arrS10(i, k)
        Next k
        For j = 1 To UBound(arrS11, 1)
            If arrS11(j, 1) = TecTron And arrS11(j, 2) = n_FOP Then
                For k = 1 To 7
                    arrRez(i, k + 8) = arrS11(j, k)
                Next k
                Exit For
            End If
        Next j
    Next i
    
    Set r = wsR.Range(s10Addr).Resize(UBound(arrRez, 1), UBound(arrRez, 2))
    r = arrRez
    Application.ScreenUpdating = True
    
End Sub
Nu aveţi permisiunea de a vizualiza fişierele ataşate acestui mesaj.
Am invatat sa inotam in apa, ca pestii
Am invatat sa zburam in aer, ca pasarile
A ramas doar sa invatam sa traim pe Pamant, ca Oamenii.

razzvan_17
Mesaje: 10
Membru din: Mie Dec 17, 2014 8:59 am

Re: Creare macrou dupa inserare fisier sursa

Mesaj de razzvan_17 » Joi Mar 01, 2018 3:00 pm

Multumesc frumos pentru ajutor ! Imi este de mare folos acest inceput.

Atasez fisierul sursa si incerc sa detaliez mai clar .
Fisier sursa - este fisierul pe care il primesc pentru analiza, de la A la J este pt S-1 , iar de la I la O este pt S curent .
In acest fisier sursa apar sau dispar linii ceea ce produce o dezordine totala . La fiecare extractie in parte se insereseaza linii pentru a aduce liniile din S-1 paralele cu cele din S curent.

Atasez fisierul macrou , pentru a crea ceea ce doresc .
Sa incarc fisierul sursa si sa mi calculeze automat inserarea liniilor necesare pentru a le aduce paralel pe fiecare in parte.

Daca se poate , va raman recunoscator si va multumesc in avans!

O zi buna!
Nu aveţi permisiunea de a vizualiza fişierele ataşate acestui mesaj.

Închis

Înapoi la “Intrebari despre Excel 2016”