Attribute VB_Name = "rowcommit_new"
Option Explicit

Sub rowcommit(etalon As Long, beg_dani As Long, shirina As Long, stolbci As String)



Dim i As Long, st_len As Long, p As Long, m1 As Long, m2 As Long, f As Long, k As Long, t As Long, shir_max As Long, ws As Worksheet, m As String, len_stolbec As Long
Dim stolbec() As String, mass_dani() As String


              


For Each ws In Application.ActiveWorkbook.Worksheets
                ws.Activate
 
 If Left(Cells(3, 1).Value, 8) = "startcom" Then
                     stolbci = Right(Cells(3, 1).Value, Len(Cells(3, 1).Value) - 8)
                     Cells(3, 1).Value = ""
                     len_stolbec = Len(stolbci)
                     ReDim stolbec((len_stolbec - 1) / 2 + 1)
       
                      k = 0
                      st_len = 1
                     For i = 1 To len_stolbec
                       If Left(stolbci, 1) <> "/" And Mid(stolbci, 2, 1) <> "/" Then
                            st_len = 2
                       End If
                       If st_len = 2 Then
                             If Left(stolbci, 1) <> "/" And Mid(stolbci, 2, 1) <> "/" And Mid(stolbci, 2, 1) <> "" Then
                                     stolbec(k) = Left(stolbci, st_len)
                                     k = k + 1
                               End If
                       Else
                               If Left(stolbci, 1) <> "/" Then
                                     stolbec(k) = Left(stolbci, st_len)
                                     k = k + 1
                               End If
                        End If
                       stolbci = Right(stolbci, Len(stolbci) - 1)
                               
                      Next
                    

                     i = 1
                     f = beg_dani
                    
		     Cells(f, etalon).Select


	             Do While ActiveCell.Value <> "finish" And ActiveSheet.Rows.Count > f
                      ReDim Preserve mass_dani(2, i)
        		 mass_dani(1,i) = Cells(f, etalon).Value
                         mass_dani(2,i) = Cells(f, etalon).Row
                         i = i + 1
                         f = f + 1
                         Cells(f, etalon).Select
                     Loop
                     Cells(f, etalon).Value = ""
                                          
                                        
                     m2 = 1                            	
                     i = 1
                     p = 0
                     m1 = 1
                     For k = 1 To f - beg_dani
                         If mass_dani(1,k) = mass_dani(1,k - 1) And Trim(mass_dani(1,k - 1)) <> "" Then
				p=p+1
			 else
				 If mass_dani(1,k) <> mass_dani(1,k - 1) And Trim(mass_dani(1,k - 1)) <> "" and p<>0 Then	
								
                        	        For i = 0 To (len_stolbec - 1) / 2
					     if stolbec(i)<>"" then 
        	                             	Range(stolbec(i) + mass_dani(2,k - p-1) + ":" + stolbec(i) + mass_dani(2,k-1)).Select
                                        	      With Selection
                                	                  .MergeCells = True
                        	                      End With
                	                     end if      
        	                         Next
                                     
                                     If shirina=0 Then
                                         Rows(mass_dani(2,k - p-1) + ":" + mass_dani(2,k-1)).Select
                                         Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
                                     End If
				 end if 	
    	  		 p=0
			 end if

                         If k >= beg_dani Then
                	 Rows(k).EntireRow.AutoFit
        	         Rows(k).EntireRow.AutoFit
	             	 End If
             	  	
                     Next
 End If
Next ws

End Sub

Sub RowCommitXls(cParam As String)
    Dim nParam1 As Long, nParam2 As Long, nParam3 As Long, ñParam4 As String

    nParam1 = VBA.CInt(VBA.Trim(GetStrParam(cParam, 1)))
    nParam2 = VBA.CInt(VBA.Trim(GetStrParam(cParam, 2)))
    nParam3 = VBA.CInt(VBA.Trim(GetStrParam(cParam, 3)))
    ñParam4 = VBA.CStr(VBA.Trim(GetStrParam(cParam, 4)))
    Call RowCommit(nParam1, nParam2, nParam3, ñParam4)
End Sub

Function GetStrParam(lcParam As String, ByVal lnParam As Long, Optional cPart As String = "#") As String
Dim nPos1 As Long, nPos2 As Long, i As Long
    nPos1 = 0
    i = 1
    While i < lnParam
        nPos1 = VBA.InStr(nPos1 + 1, lcParam, cPart)
        If nPos1 = 0 Then
            GetStrParam = ""
            Exit Function
        End If
        i = i + 1
    Wend
    nPos2 = VBA.InStr(nPos1 + 1, lcParam, cPart)
    nPos2 = VBA.IIf(nPos2 = 0, VBA.Len(lcParam), nPos2 - 1)
    If nPos2 > nPos1 Then
        GetStrParam = VBA.Mid(lcParam, nPos1 + 1, nPos2 - nPos1)
    Else
        GetStrParam = ""
    End If
End Function


