Перенос данных из документа в документ (не имеет решения).

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Перенос данных из документа в документ (не имеет решения). (Макросы/Sub)

zegor

Дата: Воскресенье, 11.01.2015, 17:08 | Сообщение № 1

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 132

Репутация: 1 ±

Замечаний: 0% ±

Excel 2007

Доброго дня, обитатели сего ресурса.
Позаимствовал макрос вместе с файликами из этой темы. Решил добавить массивы в файл "2", чего можно дописать в код для заполнения нового массива (в приложеном файле массив добавлен и залит красным)?

Критерий заполнения добавленного массива:
-если победила перва 2-0, тогда в массив под именем "первая" в столбце "1" +1 и во втором столбце (который"2") тоже +1. Третий столбец этого массива +0, по причине того, что 2 минус 0 будет равно 2 (первая победила с преимуществом в 2 гола).
-если победила вторая 1-3, тогда в массив "вторая" в столбце "1" +1, в столбец "2" тоже +1, в столбец "3" +0 (потому, что победа со счётом 3-1, то есть 3-1=2, преимущество в два гола).

К сообщению приложен файл: 6515484.xlsm (34.5 Kb) · 1301718.xlsx (16.5 Kb)

Сообщение отредактировал zegor - Понедельник, 12.01.2015, 13:33

Ответить

Свирид

Дата: Понедельник, 12.01.2015, 12:54 | Сообщение № 2

Группа: Пользователи

Ранг: Новичок

Сообщений: 47

Репутация: -13 ±

Замечаний: 0% ±

Excel 2010

Присоединяюсь к интересу по теме.

Ответить

zegor

Дата: Понедельник, 12.01.2015, 13:55 | Сообщение № 3

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 132

Репутация: 1 ±

Замечаний: 0% ±

Excel 2007

Смотрите, вставил в код вот такую штукенцию
[vba]

Код

    If (IshodniySheet.Cells(i, 27) - IshodniySheet.Cells(i, 28)) < 1 Then
             ItogiSheet.Cells(NomStr, NomStol + 4) = ItogiSheet.Cells(NomStr, NomStol + 4) + 0
         Else
             ItogiSheet.Cells(NomStr, NomStol + 4) = ItogiSheet.Cells(NomStr, NomStol + 4) + 1
             ItogiSheet.Cells(NomStr, NomStol + 5) = ItogiSheet.Cells(NomStr, NomStol + 5) + 0
             ItogiSheet.Cells(NomStr, NomStol + 6) = ItogiSheet.Cells(NomStr, NomStol + 6) + 0
     End If

     If (IshodniySheet.Cells(i, 27) - IshodniySheet.Cells(i, 28)) < 2 Then
             ItogiSheet.Cells(NomStr, NomStol + 5) = ItogiSheet.Cells(NomStr, NomStol + 5) + 0
         Else
             ItogiSheet.Cells(NomStr, NomStol + 4) = ItogiSheet.Cells(NomStr, NomStol + 4) + 0
             ItogiSheet.Cells(NomStr, NomStol + 5) = ItogiSheet.Cells(NomStr, NomStol + 5) + 1
             ItogiSheet.Cells(NomStr, NomStol + 6) = ItogiSheet.Cells(NomStr, NomStol + 6) + 0
     End If

     If (IshodniySheet.Cells(i, 27) - IshodniySheet.Cells(i, 28)) < 3 Then
             ItogiSheet.Cells(NomStr, NomStol + 6) = ItogiSheet.Cells(NomStr, NomStol + 6) + 0
         Else
             ItogiSheet.Cells(NomStr, NomStol + 4) = ItogiSheet.Cells(NomStr, NomStol + 4) + 0
             ItogiSheet.Cells(NomStr, NomStol + 5) = ItogiSheet.Cells(NomStr, NomStol + 5) + 0
             ItogiSheet.Cells(NomStr, NomStol + 6) = ItogiSheet.Cells(NomStr, NomStol + 6) + 1
     End If

         If (IshodniySheet.Cells(i, 28) - IshodniySheet.Cells(i, 27)) < 1 Then
             ItogiSheet.Cells(NomStr, NomStol + 7) = ItogiSheet.Cells(NomStr, NomStol + 7) + 0
         Else
             ItogiSheet.Cells(NomStr, NomStol + 7) = ItogiSheet.Cells(NomStr, NomStol + 7) + 1
             ItogiSheet.Cells(NomStr, NomStol + 8) = ItogiSheet.Cells(NomStr, NomStol + 8) + 0
             ItogiSheet.Cells(NomStr, NomStol + 9) = ItogiSheet.Cells(NomStr, NomStol + 9) + 0
     End If

     If (IshodniySheet.Cells(i, 28) - IshodniySheet.Cells(i, 27)) < 2 Then
             ItogiSheet.Cells(NomStr, NomStol + 8) = ItogiSheet.Cells(NomStr, NomStol + 8) + 0
         Else
             ItogiSheet.Cells(NomStr, NomStol + 7) = ItogiSheet.Cells(NomStr, NomStol + 7) + 0
             ItogiSheet.Cells(NomStr, NomStol + 8) = ItogiSheet.Cells(NomStr, NomStol + 8) + 1
             ItogiSheet.Cells(NomStr, NomStol + 9) = ItogiSheet.Cells(NomStr, NomStol + 9) + 0
     End If

     If (IshodniySheet.Cells(i, 28) - IshodniySheet.Cells(i, 27)) < 3 Then
             ItogiSheet.Cells(NomStr, NomStol + 9) = ItogiSheet.Cells(NomStr, NomStol + 9) + 0
         Else
             ItogiSheet.Cells(NomStr, NomStol + 7) = ItogiSheet.Cells(NomStr, NomStol + 7) + 0
             ItogiSheet.Cells(NomStr, NomStol + 8) = ItogiSheet.Cells(NomStr, NomStol + 8) + 0
             ItogiSheet.Cells(NomStr, NomStol + 9) = ItogiSheet.Cells(NomStr, NomStol + 9) + 1
     End If

[/vba]
Но теперь в некоторых случаях критерии заполнения файла "2" не соблюдаются. По сотворённому мной участку соблюдаются, обратное наблюдается по участку кода который я не менял.

Смотрите, вставил в код вот такую штукенцию
[vba]

Код

Ответить

СообщениеСмотрите, вставил в код вот такую штукенцию
[vba]

Код

Автор - zegor
Дата добавления - 12.01.2015 в 13:55

Cheshir0067

Дата: Понедельник, 12.01.2015, 17:24 | Сообщение № 4

Группа: Проверенные

Ранг: Новичок

Сообщений: 35

Репутация: 8 ±

Замечаний: 0% ±

Excel 2010

У вас есть скайп ?
Потому что по ТЗ непонятно почти ничего )

irelandzp@gmail.com

Ответить

Pelena

Дата: Понедельник, 12.01.2015, 18:15 | Сообщение № 5

Группа: Админы

Ранг: Местный житель

Сообщений: 19188

Репутация: 4421 ±

Замечаний: ±

Excel 365 & Mac Excel

Господа, Вы нарушаете Правила форума, а именно п. 5о
Надеюсь, что решение всё же будет опубликовано здесь

"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816

Ответить

Cheshir0067

Дата: Понедельник, 12.01.2015, 19:57 | Сообщение № 6

Группа: Проверенные

Ранг: Новичок

Сообщений: 35

Репутация: 8 ±

Замечаний: 0% ±

Excel 2010

Pelena, ненене скайп нужен был только чтобы уточнить тз.
Немного кривонький но рабочий код прилагаю.

[vba]

Код

Option Explicit

Sub PerenosDannyh10()

Dim PutRab As String, ItogiBook As Workbook, i, o, koef, koef2, sch1, sch2, raznica, q, e, qalifaer As Integer, IshodnayaBook As Workbook, IshodniySheet As Worksheet
Dim ItogiSheet As Worksheet, Imja As String, ImjaStr As String
Dim Chislo11, Chislo12, Chislo21, Chislo22 As Single, NomStr As Integer, NomStol As Integer
Dim a
Set IshodnayaBook = ActiveWorkbook
Set IshodniySheet = ActiveSheet
PutRab = ThisWorkbook.Path & "\"

For i = 3 To 12
koef = IshodniySheet.Cells(i, 34)
koef2 = IshodniySheet.Cells(i, 35)
sch1 = IshodniySheet.Cells(i, 27)
sch2 = IshodniySheet.Cells(i, 28)
raznica = sch1 - sch2

     If koef < -2.5 Or koef2 < -2.5 Or koef >= 2.5 Or koef2 >= 2.5 Then GoTo Sleduyuschiy

             If koef > 0 Then
                     Chislo11 = Application.WorksheetFunction.RoundDown(koef, 1)
                 Else
                     Chislo11 = Application.WorksheetFunction.RoundUp(koef, 1)
             End If

     Chislo12 = Chislo11 + 0.1
             If koef2 > 0 Then
                     Chislo21 = Application.WorksheetFunction.RoundDown(koef2, 1)
                 Else
                     Chislo21 = Application.WorksheetFunction.RoundUp(koef2, 1)
             End If

     Chislo22 = Chislo21 + 0.1

     Imja = "(" & Format(Chislo11, "0.0") & ")-(" & Format(Chislo12, "0.0") & ")"
     Set ItogiSheet = Application.Workbooks("2.xlsx").Worksheets(Imja)

     ImjaStr = "(" & Format(Chislo21, "0.0") & ")-(" & Format(Chislo22, "0.0") & ")"
     ItogiSheet.Activate
     Set a = Cells.Find(What:=ImjaStr)

If raznica > 0 Then
qalifaer = 4
Else
qalifaer = 7
raznica = raznica * (-1)
End If

If raznica >= 3 Then
q = 3
Else
q = raznica
End If
For e = 1 To 3
If q > 0 Then
o = 1
Else
o = 0
End If
Cells(a.Row, a.Column + qalifaer + e - 1) = Cells(a.Row, a.Column + qalifaer + e - 1) + o
q = q - 1
Next e

Sleduyuschiy:
Next i

End Sub

[/vba]
как то так.

Pelena, ненене скайп нужен был только чтобы уточнить тз.
Немного кривонький но рабочий код прилагаю.

[vba]

Код

[/vba]
как то так.Cheshir0067

irelandzp@gmail.com

Ответить

СообщениеPelena, ненене скайп нужен был только чтобы уточнить тз.
Немного кривонький но рабочий код прилагаю.

[vba]

Код

[/vba]
как то так.

Автор - Cheshir0067
Дата добавления - 12.01.2015 в 19:57

Свирид

Дата: Понедельник, 12.01.2015, 20:28 | Сообщение № 7

Группа: Пользователи

Ранг: Новичок

Сообщений: 47

Репутация: -13 ±

Замечаний: 0% ±

Excel 2010

А так чтобы и всё остальное заполнялось? Здесь же всего шесть ячеек заполняется.

Ответить

Cheshir0067

Дата: Понедельник, 12.01.2015, 20:34 | Сообщение № 8

Группа: Проверенные

Ранг: Новичок

Сообщений: 35

Репутация: 8 ±

Замечаний: 0% ±

Excel 2010

Свирид, Заполнялось где в файле 1 или файле 2 ?

irelandzp@gmail.com

Ответить

Свирид

Дата: Понедельник, 12.01.2015, 20:48 | Сообщение № 9

Группа: Пользователи

Ранг: Новичок

Сообщений: 47

Репутация: -13 ±

Замечаний: 0% ±

Excel 2010

Cheshir0067, в файле 2. Там же только центр теперь заполняется.

Описание внутри. Вот то что сейчас у вас получилось плюс то что в файле. Раз добавили ячеек в файл 2 то запоняться будут все, не только же центральные которые?

К сообщению приложен файл: 6365628.xlsm (22.9 Kb)

Сообщение отредактировал Свирид - Понедельник, 12.01.2015, 20:53