Visual Basic, .NET, ASP, VBScript
 

   
   
     

Форум - VBA

Страница: 1 | 2 |

 

  Вопрос: Помогите плииз!!! Добавлено: 17.05.09 11:18  

Автор вопроса:  jeka

Ответить

  Ответы Всего ответов: 19  

Номер ответа: 16
Автор ответа:
 jeka



Вопросов: 1
Ответов: 5
 Профиль | | #16 Добавлено: 18.05.09 18:11
оооо блин =) ну поставьте код плииз! =)

Ответить

Номер ответа: 17
Автор ответа:
 mc-black



ICQ: 308-534-060 

Вопросов: 20
Ответов: 1860
 Web-сайт: mc-black.narod.ru/dzp.htm
 Профиль | | #17
Добавлено: 18.05.09 21:21
Пжалста!!! У нас с Aston сегодня благотворительная акция. ;-)

  1. Option Explicit
  2.  
  3. Sub AppProv(wsh As Worksheet, debet As String, credit As String, sum As Currency)
  4.     Dim i As Long
  5.     Dim j As Long
  6.     Dim b As Boolean
  7.     
  8.     b = True
  9.     i = 4
  10.     Do While (Not wsh.Cells(i, 1).Value = Empty) And (CStr(wsh.Cells(i, 1).Value) <= debet)
  11.         If CStr(wsh.Cells(i, 1).Value) = debet Then
  12.             b = False
  13.             Exit Do
  14.         End If
  15.         i = i + 1
  16.     Loop
  17.     If b Then
  18.         wsh.Rows(i).Insert Shift:=xlDown
  19.         wsh.Cells(i, 1).FormulaR1C1 = "'" & debet
  20.     End If
  21.     
  22.     b = True
  23.     j = 2
  24.     Do While (Not wsh.Cells(3, j).Value = Empty) And (CStr(wsh.Cells(3, j).Value) <= credit)
  25.         If CStr(wsh.Cells(3, j).Value) = credit Then
  26.             b = False
  27.             Exit Do
  28.         End If
  29.         j = j + 1
  30.     Loop
  31.     If b Then
  32.         wsh.Columns(j).Insert Shift:=xlRight
  33.         wsh.Cells(3, j).FormulaR1C1 = "'" & credit
  34.     End If
  35.     
  36.     wsh.Cells(i, j).Value = wsh.Cells(i, j).Value + sum
  37. End Sub
  38.  
  39. Sub qwe()
  40.     AppProv ThisWorkbook.Worksheets(1), "01", "51", 50
  41.     AppProv ThisWorkbook.Worksheets(1), "50", "51", 100
  42.     AppProv ThisWorkbook.Worksheets(1), "51", "02", 150
  43.     AppProv ThisWorkbook.Worksheets(1), "02", "71", 200
  44.     AppProv ThisWorkbook.Worksheets(1), "71", "70", 250
  45.     AppProv ThisWorkbook.Worksheets(1), "70", "01", 300
  46. End Sub

Обратите внимание, пример заполнения шахматки никакой смысловой нагрузки не несет и все (или большая часть) проводок не имеют смысла, они просто приведены, чтобы показать работу по заполнению шахматки. У меня вариант функции с сортировкой номеров счетов. Сверху выделяется место под две строки на заголовки шахматки. Типа шахматка такого-то предприятия за такой-то период.

Ответить

Номер ответа: 18
Автор ответа:
 Aston



ICQ: 214-179-991 

Вопросов: 42
Ответов: 272
 Профиль | | #18 Добавлено: 18.05.09 21:42
Я свой ставлю мой простой и сделан быстро. Максим твой пример чуть позже гляну ша времени нет - зовут помочь. Мой без сортировки тое тупо размещает по ячейкам.
  1. Dim i As Integer
  2. Private Sub CommandButton1_Click()
  3. If i = 0 Then
  4. i = 2
  5. Shahmatka.Cells(1, 1) = "&#196;&#229;&#225;&#232;&#242;\&#202;&#240;&#229;&#228;&#232;&#242;"
  6. Shahmatka.Cells(1, i) = TextBox1.Text
  7. Shahmatka.Cells(i, 1) = TextBox2.Text
  8. If Trim(TextBox1.Text) = Trim(TextBox2.Text) Then
  9. Shahmatka.Cells(i, i) = "x"
  10. Else
  11. Shahmatka.Cells(i, i) = TextBox3.Text
  12. End If
  13. Else
  14. i = i + 1
  15. Shahmatka.Cells(1, i) = TextBox1.Text
  16. Shahmatka.Cells(i, 1) = TextBox2.Text
  17. If Trim(TextBox1.Text) = Trim(TextBox2.Text) Then
  18. Shahmatka.Cells(i, i) = "x"
  19. Else
  20. Shahmatka.Cells(i, i) = TextBox3.Text
  21. End If
  22. End If
  23. End Sub

Ответить

Номер ответа: 19
Автор ответа:
 Aston



ICQ: 214-179-991 

Вопросов: 42
Ответов: 272
 Профиль | | #19 Добавлено: 18.05.09 21:44
shahmatka - имя листа)

Ответить

Страница: 1 | 2 |

Поиск по форуму



© Copyright 2002-2011 VBNet.RU | Пишите нам