TRN

В SF_DatePick ред 209 определя къде да се визуализира формата SF_DatePick.Top = UserForm1.Top Например така SF_DatePick.Top = UserForm1.Top + UserForm1.Height ще се появи под формата

Поправката е в ред 32 на UserForm1 CStr(ara.Offset(0, 3).Value) = CStr(ComboBox1.Text) Then Прилагам и файла с поправките filtering_between_two_dates_userformNew.xls

За техническата грешка няма да говорим, въпроса е дали логиката за макроса е вярна. Ако е така, и съм изпуснал, че в колона A липсват данни, нищо не ми пречи да проверявам колона B, а пък номерацията да я слагам в колона A. Все пак това е вариант и може да се доработва. Нали това е целта на занятието. А и той от секретност ли от какво ли е дал една малка чстичка, кой знае от къде преписана, а така само ще си приказваме без да знаем за какво по-точно става въпрос.

Не съм имал някаква представа, че питащия въобще не се е занимавал с макроси. Не съм сигурен дали и ще разбере голяма част от това, което е направено. Аз разбрах нещата по този начин. Да се номерират данните в колона А, като се следи тези, които са от различни обекти да имат различна поредност на номерацията /1,2,.../ В списъка с фактури има написани повтарящи се фактури, в които реално има продадени/закупени/ няколко артикула и в тях номерацията трябва да се запазва същата и да не се увеличава. За да се изпълни това, не съм го писал в обясненията защото забравих, е необходимо данните от тази фактура да са една след друга, което за мен е логично, но знае ли се. С тези критерии направих макроса, като в колона F съм разположил списъка с обектите/неповтарящи се/. А защо е номерирането в колона E, за да се сравни колона E с неговата A и да се провери правилно ли са номерирани или не. А по нататък вече всеки може да прецени къде да разположи данните, които са ми в колона F и G, което е елементарно. И пак да не се забравя, че не съм разбрал, че питащия за първи път се опитва да пише макроси. При мен макроса работи нормално, а иначе не бих го предложил. А за сортировката, така както иска, аз лично мога да предложа само филтриране и SubTotal. Е ако не знае как може пак да пита. И благодаря за обяснението за Attachment. Не бих се сетил да ровя там. SoftVisaObjectNumbers.xlsm

Никой до този момент не е казал, че макроса не работи. Много добре знам, че при различни версии на Excel може да се получат грешки или грешни резултати. Аз работя с 2013. Аз не съм си измислял никакъв файл, просто съм ползвал неговия. Щом имаш желание ще го кача, като съм добавил и макроса за сортиране. Съжалявам, но не намирам бутон за Attacment.

Нямам желание да си подхвърляме реплики. Никой не знае какви са познанията на питащия. Но да нямаш абсолютно никакви, кой може да очаква това. А с елементарни познания може поне да направи така, че това, което му се дава, да го нагласи за неговите си нужди. Няма повече да се намесвам в темата.

В моя отговор съм ти дал макрос за номериране, а вместо да го ползваш, вземаш макроса за сортиране. Но ако за първи път отваряш Excel за да пишеш макроси, не знам как ще стане. За питане № 1 може да се ползва функцията SubTotal. В Help има обяснение как се ползва. И как ще стане изчисляването на стойността на документите, като никъде не се виждат някакви суми.

Не виждам как това може да стане с формули. Ето един макрос, набързо скалъпен, но това, което е дадено за пример го решава Но ако не си запознат с макросите, не знам за какво се захващаш. Това поне е малко по-сложничко. Направил съм да номерира данните не върху таблицата а в колона G Колона F ползвам за списък на всички неповтарящи се обекти от колона Е Option Explicit Type MyData NumObject As Integer NumPoRed As Long NumDocu As Long End Type Sub CreatePorNumbers() Dim MyObjects() As MyData Dim I As Long Dim MaxRow As Long Dim Rng As Range Dim MyRange As Range MaxRow = Range("A" & Rows.Count).End(xlUp).Row Set MyRange = Range("A2:A" & MaxRow) Range("E2:E" & MaxRow).Copy Destination:=Range("F2") If MaxRow > 3 Then 'Отстраняване на повтарящи се номера ActiveSheet.Range("$F$2:$F$" & MaxRow).RemoveDuplicates Columns:=Array(1), Header:=xlNo End If MaxRow = Range("F" & Rows.Count).End(xlUp).Row ReDim MyObjects(1 To MaxRow - 1) For I = 2 To MaxRow MyObjects(I - 1).NumObject = Range("F" & I).Value Next For Each Rng In MyRange For I = LBound(MyObjects) To UBound(MyObjects) If Rng.Offset(, 4).Value = MyObjects(I).NumObject Then If MyObjects(I).NumDocu <> Rng.Offset(, 1).Value Then MyObjects(I).NumPoRed = MyObjects(I).NumPoRed + 1 Rng.Offset(, 6).Value = MyObjects(I).NumPoRed MyObjects(I).NumDocu = Rng.Offset(, 1).Value Else Rng.Offset(, 6).Value = MyObjects(I).NumPoRed End If End If Next Next End Sub

https://bg.wikipedia.org/wiki/Microsoft_.NET_Framework

Прегледай това http://answers.microsoft.com/en-us/windows/forum/windows_7-update/windows-updates-failed-want-to-delete-all-failed/2b12cd32-7dbb-4437-9c9c-e8c81fe948fa

Понеже не се знае версията на Word казвам за Word 2010 Натиска се File Button, след което Options. Избира се Display и от Printing Options се маха отметката пред Print document properties, след което се натиска OK. А за останалите версии от този линк.https://support.microsoft.com/bg-bg/kb/890897

1. Маркират се всички колони вдясно до края и се скриват/Hide/. Маркират се всички редове надолу до края и се скриват/Hide/.2. Това са двата макроса, които ти предлагам, като информацията се показва в Status Bar/лентата най-долу, вляво/. В момента се появява само стойността на клетката, останалото може да се доработи. Макросите се копират в модула на страницата, за която се отнасят. В момента се използва клетка "А1", за работа с друга клетка се сменя Set rng1=Range("Нова клетка") и в двата макросаPrivate Sub Worksheet_Change(ByVal Target As Range) Dim rng1 As Range Set rng1 = Range("A1") On Error Resume Next If Not Application.Intersect(Target, rng1) Is Nothing Then Application.StatusBar = Range("A1").Value End IfEnd Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim rng1 As Range Set rng1 = Range("A1") On Error Resume Next If Application.Intersect(Target, rng1) Is Nothing Then Application.StatusBar = False End IfEnd Sub3.Елементите в списъка може да ги въведеш ръчно в полето Source: на DataValidation, като ги разделяш с List Separator, който е избран от Регионалните настройки

Позволих си да направя няколко корекции в макроса.1. Извършва се проверка за наличие на името на обобщения файл в списъка и ако е така не извежда данни от него.2. Проверката за кой ред следват данните се извършва по двете колони F и G, защото едната може да няма данни3. В колони 6 или 7 се извеждат нули, защото се използва функция, а тя винаги връща някакъв резултат. Използвал съм проверка TypeName за типа на връщания резултат, ако е = String да извежда данните - това в момента е вярното4. променил съм пътя до директорията, защото така в момента е фиксирана и на друг компютър няма да работи. Sub CombData_Macro1111111111111111111111111111()Dim stringSource As StringSet targetWorksheets = ThisWorkbook.Worksheets(1) currentFile = Dir(ThisWorkbook.Path & "\*.xls*") Do While currentFile <> "" If ThisWorkbook.Name <> currentFile Then stringSource = "'" & ThisWorkbook.Path & "\[" & currentFile & "]Sheet1'!R4C1:R4C1" rowCounter = Application.WorksheetFunction.Max( _ targetWorksheets.Cells(targetWorksheets.Rows.Count, "F").End(xlUp).Row + 1, _ targetWorksheets.Cells(targetWorksheets.Rows.Count, "G").End(xlUp).Row + 1) targetWorksheets.Cells(rowCounter, 1).Value = Application.ExecuteExcel4Macro(stringSource) stringSource = "'" & ThisWorkbook.Path & "\[" & currentFile & "]Sheet1'!R4C2:R4C2" targetWorksheets.Cells(rowCounter, 2).Value = Application.ExecuteExcel4Macro(stringSource) stringSource = "'" & ThisWorkbook.Path & "\[" & currentFile & "]Sheet1'!R4C3:R4C3" targetWorksheets.Cells(rowCounter, 3).Value = Application.ExecuteExcel4Macro(stringSource) stringSource = "'" & ThisWorkbook.Path & "\[" & currentFile & "]Sheet1'!R4C4:R4C4" targetWorksheets.Cells(rowCounter, 4).Value = Application.ExecuteExcel4Macro(stringSource) stringSource = "'" & ThisWorkbook.Path & "\[" & currentFile & "]Sheet1'!R9C2:R9C2" targetWorksheets.Cells(rowCounter, 5).Value = Application.ExecuteExcel4Macro(stringSource) stringSource = "'" & ThisWorkbook.Path & "\[" & currentFile & "]Sheet1'!R10C3:R10C3" If TypeName(Application.ExecuteExcel4Macro(stringSource)) = "String" Then _ targetWorksheets.Cells(rowCounter, 6).Value = Application.ExecuteExcel4Macro(stringSource) stringSource = "'" & ThisWorkbook.Path & "\[" & currentFile & "]Sheet1'!R10C4:R10C4" If TypeName(Application.ExecuteExcel4Macro(stringSource)) = "String" Then _ targetWorksheets.Cells(rowCounter, 7).Value = Application.ExecuteExcel4Macro(stringSource) stringSource = "'" & ThisWorkbook.Path & "\[" & currentFile & "]Sheet1'!R9C5:R9C5" targetWorksheets.Cells(rowCounter, 8).Value = Application.ExecuteExcel4Macro(stringSource) End If currentFile = DirLoopEnd Sub