joi, 16 iulie 2015

Confirmare așteptări acțiune BVB

Salutare ! Scriam în acest articol despre acțiunea ROCE, iar în acesta am selectat-o cu ajutorul aplicației Excel drept prima recomandare pentru cumpărare.

Rezultatele au început deja să apară, creşterea pe această acţiune fiind una considerabilă în doar câteva luni de când am început să acumulez (12.5% profit în aproximativ 2-3 luni):




Nu doresc să mă laud, ci să promovez investițiile pe bursa românească și educația financiară a românilor, mai ales că în prezent volumul tracțiilor de pe bvb este unul extrem de mic comparativ cu ceea ce se întâmplă pe alte burse mai mature.

De asemenea, am observat în ultimul timp inițiative și din partea Bursei de Valori București, cum ar fi spre exemplu, programul "Fluent în Finance" , prin care bursa intenționează să atragă atenția asupra importanței de a gestiona în mod eficient propriile resurse. Pentru cei interesați a fost redactat și un ghid care poate fi descărcat și studiat gratuit aici. 

Subscribe to Un mod diferit de a privi Economia by Email
Citește în continuare ->

vineri, 3 iulie 2015

Excel VBA Split Rows Trick and Announcement

Today i have to make an announcement: in the near future I intend to migrate the blog to a new one with a new design and completely in english because I want to develop a better project and reach readers from Romania, but also from other countries. The content will remain the same: finance and accounting, Excel automations and apps, SQL, Access etc.

Now, let's talk about an Excel problem which i recently had to solve. In reality i had a worksheet with thousands of rows (so the manual work which could take days wasn't a solution), but for illustrating purposes i created a file with few rows and no confidential data :)

! Challenge: You have the data from Range("A2:E4"). Split the rows by company codes: for Each Company code separated by a character (; or , or / or -) automatically create a new row. The rest of the data from other columns remains the same for the new rows. Every Company Code string can have different lenght and betwen codes and separators can be spaces.

Initial:







Result:







My code for solving this is the following:

Sub split_rows()

'original code by Andrei Lungu

lr = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row

counter_ch = 0
ismore = False

col_comp_code = "C"

Application.ScreenUpdating = False

For i = lr To 2 Step -1

    Set check_cell0 = ActiveSheet.Range(col_comp_code & i)
    
    check_cell = Replace(check_cell0, " ", "")
    
    counter = 0
        For j = 1 To Len(check_cell)
        
            counter_ch = counter_ch + 1
            activechar = Mid(check_cell, j, 1)
            
            If activechar = "," Or activechar = ";" Or activechar = "/" Or activechar = "-" Then
            ismore = True
                Separator = activechar
                
                counter = counter + 1
                ActiveSheet.Rows(i).Offset(0).EntireRow.Insert
                where_starts = j - (counter_ch - 1)
                company_code = Mid(check_cell, where_starts, counter_ch - 1)
                
    
                ActiveSheet.Range(col_comp_code & i) = company_code
                
            counter_ch = 0
            End If
        
        Next j
                
    'last comp code
    If ismore = True Then
    
    'find out the position of the last separator
                    last_sep = counter
                    char_no = 1
                    counter2 = 0
                    For k = 1 To Len(check_cell)
                    
                        activechar2 = Mid(check_cell, k, 1)
                        char_no = char_no + 1
                        If activechar2 = "," Or activechar2 = ";" Or activechar2 = "/" Or activechar2 = "-" Then
                        counter2 = counter2 + 1
                        If counter2 = last_sep Then
                            last_sep_char_no = char_no
                            'MsgBox last_sep_char_no
                        End If
                        
                        End If
                    
                    Next k
            
    'copy last company code
        last_company_code = Right(check_cell, Len(check_cell) - last_sep_char_no + 1)
        ActiveSheet.Range(col_comp_code & i).Offset(counter) = last_company_code
        
    'copy rest of data
        Do While counter > 0
        
        ActiveSheet.Range("A" & i & ":B" & i).Offset(counter).Copy ActiveSheet.Range("A" & i & ":B" & i).Offset(counter - 1)
        ActiveSheet.Range("D" & i & ":E" & i).Offset(counter).Copy ActiveSheet.Range("D" & i & ":E" & i).Offset(counter - 1)
        counter = counter - 1
        Loop
    
    End If
    
    ismore = False
    
        counter_ch = 0
        counter = 0

Next i

Application.ScreenUpdating = False

End Sub

If you have other ideas please share them in a comment.

The sample file can be downloaded from this location.

Subscribe to Un mod diferit de a privi Economia by Email
Citește în continuare ->