[حل شده] جمع كردن كدهاي مشابه در يك شيت

[mostafa_s]

سلام خدمت دوستان عزيز و اساتيد مهربان:
در صورت امكان مشكل بنده كه در فايل ضميمه توضيح دادم روراهنمايي كنيد ممنونم.
[فراخوانی کد.rar

[shamsololama]

بادرود فراوان

خدمت شما نتیجه با کلیک روی باتوم در شیت بعدی ایجاد میکند

[mostafa_s]

بادرود فراوان

خدمت شما نتیجه با کلیک روی باتوم در شیت بعدی ایجاد میکند

درود فراوان بر شما ممنونم از لطفتون واقعاعالی سپاسگزارم

[mostafa_s]

ba drod

man yeki ke dar moghabele ostad shams hafi vase goftan nadaram ama chon hamishe migan rahaye mokhtalefio test konim va be man ide gerftano khob yad dadan manam ye rahale dige raftam
be in sorat ke farz bar ine ke alan shoma etelati ro vared nakardin va taze mikhin shoro konin

khob man kode klidio ke to file zir baraton gozashtamo mizaram va bad tashrihesh mikonim. zemnan sharmande daneshgaham va keyboard farsi nadaram

Private Sub CommandButton2_Click()
If Sheet2.Range("B7").Value = False Then
MsgBox "Please enter the number of your Item", vbCritical, "Incomplete information"
Exit Sub
End If
On Error GoTo MyErrorHandler:
Dim c, T
c = Sheet2.Range("B7").Value
T = Sheet1.Range("B2:G" & Sheet1.Cells(Rows.Count, "A").End(xlUp).Row)
Sheet2.Range("C7").Value = Application.WorksheetFunction.VLookup(c, T, 2, False)
Sheet2.Range("D7").Value = Application.WorksheetFunction.VLookup(c, T, 3, False)
Sheet2.Range("E7").Value = Application.WorksheetFunction.VLookup(c, T, 4, False)
Sheet2.Range("F7").Value = Application.WorksheetFunction.VLookup(c, T, 5, False)
Sheet2.Range("G7").Value = Application.WorksheetFunction.VLookup(c, T, 6, False)


'"""""""""" Transfer data

If Application.WorksheetFunction.CountIf(Sheet3.Range("B1:B" & Sheet3.Cells(Rows.Count, "A").End(xlUp).Row), c) = 0 Then
Dim n As Long
n = Sheet3.Cells(Rows.Count, "B").End(xlUp).Row
Sheet3.Range("B" & n + 1).Value = Sheet2.Range("B7").Value
Sheet3.Range("C" & n + 1).Value = Sheet2.Range("C7").Value
Sheet3.Range("D" & n + 1).Value = Sheet2.Range("D7").Value
Sheet3.Range("E" & n + 1).Value = Sheet2.Range("E7").Value
Sheet3.Range("F" & n + 1).Value = Sheet2.Range("F7").Value
Sheet3.Range("G" & n + 1).Value = Sheet2.Range("G7").Value
Sheet3.Range("A" & n + 1).Value = n
         MsgBox "sapt Shod"
         Else
         Dim s
         s = Application.WorksheetFunction.Match(c, Sheet3.Range("B1:B" & Sheet3.Cells(Rows.Count, "A").End(xlUp).Row), 0)
         Sheet3.Range("B" & s).Value = Sheet2.Range("B7").Value
Sheet3.Range("C" & s).Value = Sheet2.Range("C7").Value
Sheet3.Range("D" & s).Value = Sheet2.Range("D7").Value
Sheet3.Range("E" & s).Value = Sheet2.Range("E7").Value
Sheet3.Range("F" & s).Value = Sheet2.Range("F7").Value
Sheet3.Range("G" & s).Value = Sheet2.Range("G7").Value + Sheet3.Range("G" & s).Value
MsgBox "sapt Shod"
         End If
      
Exit Sub
MyErrorHandler:
If Err.Number = 1004 Then
  MsgBox "the code that you entered is not valid"
End If

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Target.Worksheet.Range("B7")) Is Nothing Then
    Sheet2.Range("C7").Value = ""
Sheet2.Range("D7").Value = ""
Sheet2.Range("E7").Value = ""
Sheet2.Range("F7").Value = ""
Sheet2.Range("G7").Value = ""
    End If
End Sub

khob dar morede code clide 2
avalesh ma miaim baesi mikonim ke user ma hatman code marbot be jostejo ro vared karde bash va agar nakarde bashe ye payam bede ke shoma code item ro vared nakardin va az dastorat ba code exit sub be tor kamel kharej beshe

dar marhale bad ba code vlookup omdaim item jostejoro pida kardim ba dar khane haye mazkor ke c 7 ta g 7 az sheet 2 hastesh ro ba vlook up por mikonim.
nokte agar karbar code ro be eshtebah vared kone ke dar list ma nabashe vlookk up ero mide , dar inja ma az erro hanndel komak ereftim ke ghable code hamon ono ovordim va be entehaye code hamon erjaesh dadim

marhale bad enteghale etelate pida shode be shite 3 hastesh ke dar inja ma ba 2 halat tarafim
1- in etelat baraye valin bar daran sabt mishan ya na
pas az countif estefade kardim ke code iiii ro ke dar B7 dar sheet 2 vared kardim ro ebteda tedadesho beshmore dar sheet3 setone b agar barabar 0 bod yani avalin bare pas hamon etelato mire to hamon sheet va dar akhrin cell ke khli hastesh copy mikone
2 halate 2 , halati hast ke ghablan sabt shode pas in etelate jadid bayad ba ghablie ke dar sheet 3 hastesh jam beshe bena be farmayeshe shoma, pas ma aval moghiate code vared shodaro to sheet 3 ba function match pida mikonim va bade be rahati mitoni hame etelato be hamon radif erjaesh bedim

dar nahayatam ye code gozashtim to change sheet 2 ke harvaght b7 taghir kard etelatesh dar sotonhaye mojaveresh C...G pak beshan va amade baraye run
dar zemn radif dar sheet 3 uokhodesh vared mishe automatic
movafagh va piroz basgid

khaili mamnonam sharmandh kardid ma ra be khoda

[امين اسماعيلي]

ba drod
sharmande dige tapic basas ama khob ino ham ye negah bendazin
yekam tebghe mamol ajale kardim file camo kasri dasht